نمونه کد کار با system restor

در کد زیر کار با system Restore point ویندوز را یاد خواهید گرفت. دسترسی به اخرین تغییرات در ویندوز

نکته:در ویندوز 7 Run as Admin… فراموش نشود

program WMIShowRestorePoints;

 ///www.delphiplus.ir
 ///  wwww.lear4u.blogsky.com
{$APPTYPE CONSOLE}

uses
  SysUtils
  ,ActiveX
  ,ComObj
  ,Variants;

function RestorePointTypeToStr(RestorePointType:Integer):string;
begin
     case  RestorePointType of
      0  : Result:='APPLICATION_INSTALL';
      1  : Result:='APPLICATION_UNINSTALL';
      13 : Result:='CANCELLED_OPERATION';
      10 : Result:='DEVICE_DRIVER_INSTALL';
      12 : Result:='MODIFY_SETTINGS'
      else
      Result:='Unknow';
     end;
end;

function EventTypeToStr(EventType:integer) : string;
begin
     case  EventType of
      102  : Result:='BEGIN_NESTED_SYSTEM_CHANGE';
      100  : Result:='BEGIN_SYSTEM_CHANGE';
      103  : Result:='END_NESTED_SYSTEM_CHANGE';
      101  : Result:='END_SYSTEM_CHANGE'
      else
      Result:='Unknow';
     end;
end;

function WMITimeToStr(WMITime:string) : string; //convert to dd/mm/yyyy hh:mm:ss
begin
    //20020710113047.000000420-000 example    source <a href="http://technet.microsoft.com/en-us/library/ee156576.aspx">http://technet.microsoft.com/en-us/library/ee156576.aspx</a>
    result:=Format('%s/%s/%s %s:%s:%s',[copy(WMITime,7,2),copy(WMITime,5,2),copy(WMITime,1,4),copy(WMITime,9,2),copy(WMITime,11,2),copy(WMITime,13,2)]);
end;

procedure GetRestorePoints;
var
  objWMIService : OLEVariant;
  colItems      : OLEVariant;
  colItem       : OLEVariant;
  oEnum         : IEnumvariant;
  iValue        : LongWord;

  User          : OLEVariant;
  Domain        : OLEVariant;

  function GetWMIObject(const objectName: String): IDispatch;
  var
    chEaten: Integer;
    BindCtx: IBindCtx;
      Moniker: IMoniker;
  begin
    OleCheck(CreateBindCtx(0, bindCtx));
    OleCheck(MkParseDisplayName(BindCtx, StringToOleStr(objectName), chEaten, Moniker));
    OleCheck(Moniker.BindToObject(BindCtx, nil, IDispatch, Result));
  end;

begin
  objWMIService := GetWMIObject('winmgmts:\\localhost\root\default');
  colItems      := objWMIService.ExecQuery('SELECT * FROM SystemRestore','WQL',0);
  oEnum         := IUnknown(colItems._NewEnum) as IEnumVariant;
  while oEnum.Next(1, colItem, iValue) = 0 do
  begin
      WriteLn(Format('%s %-15s',['Description',colItem.Description]));
      WriteLn(Format('%s %-15s',['RestorePointType',RestorePointTypeToStr(colItem.RestorePointType)]));
      WriteLn(Format('%s %-15s',['EventType',EventTypeToStr(colItem.EventType)]));
      WriteLn(Format('%s %-15s',['SequenceNumber',colItem.SequenceNumber]));
      WriteLn(Format('%s %-15s',['CreationTime',WMITimeToStr(colItem.CreationTime)]));
      Writeln('');
  end;
end;

begin
 try
    CoInitialize(nil);
    try
      GetRestorePoints;
      Readln;
    finally
    CoUninitialize;
    end;
 except
    on E:Exception do
    Begin
        Writeln(E.Classname, ': ', E.Message);
        Readln;
    End;
  end;
end.

صدا زدن اینترنت اکسپلورر از درون دلفی

program IExplor;

uses
  Windows, OLEAuto;

procedure OpenInternetExplorer(sURL: string);
const
  csOLEObjName = 'InternetExplorer.Application';
var
  IE        : Variant;
  WinHandle : HWnd;
begin
  if VarIsEmpty(IE) then
  begin
    IE := CreateOleObject(csOLEObjName);
    IE.Visible := true;
    IE.Navigate(sURL);
  end
  else
  begin
    WinHandle := FindWIndow('IEFrame', nil);
    if(0 <> WinHandle) then
    begin
      IE.Navigate(sURL);
      SetForegroundWindow(WinHandle);
    end
    else
    begin
      // handle error ...
    end;
  end;
end;

begin
  OpenInternetExplorer('http://lear4u.blogsky.com/');
end

اجرای فرامین dos و نمایش خروجی

function GetDosOutput(CommandLine: string; Work: string = 'C:\'): string;
var
  SA: TSecurityAttributes;
  SI: TStartupInfo;
  PI: TProcessInformation;
  StdOutPipeRead, StdOutPipeWrite: THandle;
  WasOK: Boolean;
  Buffer: array[0..255] of AnsiChar;
  BytesRead: Cardinal;
  WorkDir: string;
  Handle: Boolean;
begin
  Result := '';
  with SA do begin
    nLength := SizeOf(SA);
    bInheritHandle := True;
    lpSecurityDescriptor := nil;
  end;
  CreatePipe(StdOutPipeRead, StdOutPipeWrite, @SA, 0);
  try
    with SI do
    begin
      FillChar(SI, SizeOf(SI), 0);
      cb := SizeOf(SI);
      dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
      wShowWindow := SW_HIDE;
      hStdInput := GetStdHandle(STD_INPUT_HANDLE); // don't redirect stdin
      hStdOutput := StdOutPipeWrite;
      hStdError := StdOutPipeWrite;
    end;
    WorkDir := Work;
    Handle := CreateProcess(nil, PChar('cmd.exe /C ' + CommandLine),
                            nil, nil, True, 0, nil,
                            PChar(WorkDir), SI, PI);
    CloseHandle(StdOutPipeWrite);
    if Handle then
      try
        repeat
          WasOK := ReadFile(StdOutPipeRead, Buffer, 255, BytesRead, nil);
          if BytesRead > 0 then
          begin
            Buffer[BytesRead] := #0;
            Result := Result + Buffer;
          end;
        until not WasOK or (BytesRead = 0);
        WaitForSingleObject(PI.hProcess, INFINITE);
      finally
        CloseHandle(PI.hThread);
        CloseHandle(PI.hProcess);
      end;
  finally
    CloseHandle(StdOutPipeRead);
  end;
end;

غیرفعال کردن ctrl+n در web browser

procedure TfrmMyBrowser.ApplicationEvents1Message(var Msg: tagMSG;
  var Handled: Boolean);
begin
  // check if Ctrl-N pressed
  if (GetKeyState(VK_CONTROL) < 0) and (Msg.Message = WM_KEYDOWN) and
    (Msg.wParam = Ord('N')) then
  begin
    Handled := True;
  end;
end;

بدست آوردن تمامی عکس های درون یک صفحه وب

uses mshtml, ActiveX, COMObj, IdHTTP, idURI;
{ .... }
procedure GetImageLinks(AURL: string; AList: TStrings);
var IDoc: IHTMLDocument2;
    strHTML: string;
    v: Variant;
    x: Integer;
    ovLinks: OleVariant;
    DocURL: string;
    URI: TidURI;
    ImgURL: string;
    idHTTP: TidHTTP;
    begin
    AList.Clear;
    URI := TidURI.Create(AURL);
    try
    DocURL := 'http://' + URI.Host;
    if URI.Path <> '/' then
    DocURL := DocURL + URI.Path;
    finally
    URI.Free;
    end;
    Idoc := CreateComObject(Class_HTMLDocument) as IHTMLDocument2;
    try
    IDoc.designMode := 'on';
    while     IDoc.readyState <> 'complete' do
    Application.ProcessMessages;
    v := VarArrayCreate([0, 0], VarVariant);
    idHTTP := TidHTTP.Create(nil);
    try
    strHTML := idHTTP.Get(AURL);
    finally
    idHTTP.Free;
    end;
    v[0] := strHTML;
    IDoc.Write(PSafeArray(System.TVarData(v).VArray));
    IDoc.designMode := 'off';
    while     IDoc.readyState <> 'complete' do
    Application.ProcessMessages;
    ovLinks := IDoc.all.tags('IMG');
    if ovLinks.Length > 0 then begin
    for x := 0 to ovLinks.Length - 1 do begin
    ImgURL := ovLinks.Item(x).src;
    if (ImgURL[1] = '/') then begin
    ImgURL := DocURL + ImgUrl;
    end
    else
    begin
    if (Copy(ImgURL, 1, 11) = 'about:blank') then begin
    ImgURL := DocURL + Copy(ImgUrl, 12, Length(ImgURL));
    end;
    end;
    AList.Add(ImgURL);
    end;
    end;
    finally
    IDoc := nil;
    end;
    end;
روش استفاده////
 Example:
 procedure TForm1.Button1Click(Sender: TObject);
 begin GetImageLinks('http://lear4u.blogsky.com', Memo1.Lines);
 end

آیا url به صورت کامل باز شده است؟

  procedure pause(const ADelay: LongWord);
  var
    StartTC: DWORD;
    CurrentTC: Int64;
  begin
    StartTC := GetTickCount;
    repeat
      Application.ProcessMessages;
      CurrentTC := GetTickCount;
      if CurrentTC < StartTC then
        // tick count has wrapped around: adjust it
        CurrentTC := CurrentTC + High(DWORD);
    until CurrentTC - StartTC >= ADelay;
  end;

begin
  WebBrowser1.Navigate('http://lear4u.blogsky.com');
  while WebBrowser1.ReadyState <> READYSTATE_COMPLETE do
    Pause(5); // 5ms delay before re-testing
end;

قطع کردن امن usb

safely remove usb

function OpenVolume(ADrive: char): THandle;
var
  RootName, VolumeName: string;
  AccessFlags: DWORD;
begin
  RootName := ADrive + ':' + #134; // ADrive + ':\' kills the syntax highlighting
  case GetDriveType(PChar(RootName)) of
    DRIVE_REMOVABLE:
      AccessFlags := GENERIC_READ or GENERIC_WRITE;
    DRIVE_CDROM:
      AccessFlags := GENERIC_READ;
  else
    Result := INVALID_HANDLE_VALUE;
    exit;
  end;
  VolumeName := Format('\\.\%s:', [ADrive]);
  Result := CreateFile(PChar(VolumeName), AccessFlags,
    FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING, 0, 0);
  if Result = INVALID_HANDLE_VALUE then
    RaiseLastWin32Error;
end;

function LockVolume(AVolumeHandle: THandle): boolean;
const
  LOCK_TIMEOUT = 10 * 1000; // 10 Seconds
  LOCK_RETRIES = 20;
  LOCK_SLEEP = LOCK_TIMEOUT div LOCK_RETRIES;

// #define FSCTL_LOCK_VOLUME CTL_CODE(FILE_DEVICE_FILE_SYSTEM, 6, METHOD_BUFFERED, FILE_ANY_ACCESS)
  FSCTL_LOCK_VOLUME = (9 shl 16) or (0 shl 14) or (6 shl 2) or 0;
var
  Retries: integer;
  BytesReturned: Cardinal;
begin
  for Retries := 1 to LOCK_RETRIES do begin
    Result := DeviceIoControl(AVolumeHandle, FSCTL_LOCK_VOLUME, nil, 0,
      nil, 0, BytesReturned, nil);
    if Result then
      break;
    Sleep(LOCK_SLEEP);
  end;
end;

function DismountVolume(AVolumeHandle: THandle): boolean;
const
// #define FSCTL_DISMOUNT_VOLUME CTL_CODE(FILE_DEVICE_FILE_SYSTEM, 8, METHOD_BUFFERED, FILE_ANY_ACCESS)
  FSCTL_DISMOUNT_VOLUME = (9 shl 16) or (0 shl 14) or (8 shl 2) or 0;
var
  BytesReturned: Cardinal;
begin
  Result := DeviceIoControl(AVolumeHandle, FSCTL_DISMOUNT_VOLUME, nil, 0,
    nil, 0, BytesReturned, nil);
  if not Result then
    RaiseLastWin32Error;
end;

function PreventRemovalOfVolume(AVolumeHandle: THandle;
  APreventRemoval: boolean): boolean;
const
// #define IOCTL_STORAGE_MEDIA_REMOVAL CTL_CODE(IOCTL_STORAGE_BASE, 0x0201, METHOD_BUFFERED, FILE_READ_ACCESS)
  IOCTL_STORAGE_MEDIA_REMOVAL = ($2d shl 16) or (1 shl 14) or ($201 shl 2) or 0;
type
  TPreventMediaRemoval = record
    PreventMediaRemoval: BOOL;
  end;
var
  BytesReturned: Cardinal;
  PMRBuffer: TPreventMediaRemoval;
begin
  PMRBuffer.PreventMediaRemoval := APreventRemoval;
  Result := DeviceIoControl(AVolumeHandle, IOCTL_STORAGE_MEDIA_REMOVAL,
    @PMRBuffer, SizeOf(TPreventMediaRemoval), nil, 0, BytesReturned, nil);
  if not Result then
    RaiseLastWin32Error;
end;

function AutoEjectVolume(AVolumeHandle: THandle): boolean;
const
// #define IOCTL_STORAGE_EJECT_MEDIA CTL_CODE(IOCTL_STORAGE_BASE, 0x0202, METHOD_BUFFERED, FILE_READ_ACCESS)
  IOCTL_STORAGE_EJECT_MEDIA = ($2d shl 16) or (1 shl 14) or ($202 shl 2) or 0;
var
  BytesReturned: Cardinal;
begin
  Result := DeviceIoControl(AVolumeHandle, IOCTL_STORAGE_EJECT_MEDIA, nil, 0,
    nil, 0, BytesReturned, nil);
  if not Result then
    RaiseLastWin32Error;
end;

function EjectVolume(ADrive: char): boolean;
var
  VolumeHandle: THandle;
begin
  Result := FALSE;
  // Open the volume
  VolumeHandle := OpenVolume(ADrive);
  if VolumeHandle = INVALID_HANDLE_VALUE then
    exit;
  try
    // Lock and dismount the volume
    if LockVolume(VolumeHandle) and DismountVolume(VolumeHandle) then begin
      // Set prevent removal to false and eject the volume
      if PreventRemovalOfVolume(VolumeHandle, FALSE) then
        AutoEjectVolume(VolumeHandle);
    end;
  finally