[Jedi-apilib+wscl-svn] SF.net SVN: jedi-apilib:[1109] jwapi
Brought to you by:
dezipaitor,
rweijnen
From: <dez...@us...> - 2011-11-13 10:33:41
|
Revision: 1109 http://jedi-apilib.svn.sourceforge.net/jedi-apilib/?rev=1109&view=rev Author: dezipaitor Date: 2011-11-13 10:33:33 +0000 (Sun, 13 Nov 2011) Log Message: ----------- #Fix for "Suggested patch for IWbemHiPerfEnum - ID: 3432141" in trunk, branches 2.3 and 2.4a: Adapted the method GetObjects of IWbemHiPerfEnum to allow access to returned array of interfaces in Delphi. Otherwise this wasn't possible. +added KTM and VHD examples to trunk Modified Paths: -------------- jwapi/branches/2.3/Win32API/JwaWbemCli.pas jwapi/branches/2.4a/Win32API/JwaWbemCli.pas jwapi/trunk/Win32API/JwaWbemCli.pas Added Paths: ----------- jwapi/trunk/Examples/KTM/ jwapi/trunk/Examples/KTM/ExecutionLevel_AsInvoker.RES jwapi/trunk/Examples/KTM/GetFolderDialogU.pas jwapi/trunk/Examples/KTM/MainFormU.dfm jwapi/trunk/Examples/KTM/MainFormU.pas jwapi/trunk/Examples/KTM/TransactionClassU.pas jwapi/trunk/Examples/KTM/TransactionsDemo.dpr jwapi/trunk/Examples/KTM/switches.inc jwapi/trunk/Examples/VHD/ jwapi/trunk/Examples/VHD/Demo.dpr jwapi/trunk/Examples/VHD/checkwin7.pas jwapi/trunk/Examples/VHD/frmMain.dfm jwapi/trunk/Examples/VHD/frmMain.pas jwapi/trunk/Examples/VHD/res/ jwapi/trunk/Examples/VHD/res/asAdministrator.cmd jwapi/trunk/Examples/VHD/res/asAdministrator.manifest jwapi/trunk/Examples/VHD/res/asAdministrator.rc jwapi/trunk/Examples/VHD/res/asInvoker.cmd jwapi/trunk/Examples/VHD/res/asInvoker.manifest jwapi/trunk/Examples/VHD/res/asInvoker.rc jwapi/trunk/Examples/VHD/userlevel.res Modified: jwapi/branches/2.3/Win32API/JwaWbemCli.pas =================================================================== --- jwapi/branches/2.3/Win32API/JwaWbemCli.pas 2011-10-27 11:38:49 UTC (rev 1108) +++ jwapi/branches/2.3/Win32API/JwaWbemCli.pas 2011-11-13 10:33:33 UTC (rev 1109) @@ -1101,11 +1101,16 @@ PLongint = ^Longint; // TODO PLongint introduced in Delphi 6 + //CW: Make sure you deactivate range checking when using this array + TAIWbemObjectAccess = array [0..ANYSIZE_ARRAY - 1] of IWbemObjectAccess; //manually inserted declaration; not part of windows header + PAIWbemObjectAccess = ^TAIWbemObjectAccess; //manually inserted declaration; not part of windows header + IWbemHiPerfEnum = interface(IUnknown) ['{2705C288-79AE-11d2-B348-00105A1F8177}'] function AddObjects(lFlags: Longint; uNumObjects: ULONG; apIds: PLongint; apObj: PIWbemObjectAccess): HRESULT; stdcall; function RemoveObjects(lFlags: Longint; uNumObjects: ULONG; apIds: PLongint): HRESULT; stdcall; - function GetObjects(lFlags: Longint; uNumObjects: ULONG; out apObj: IWbemObjectAccess; out puReturned: ULONG): HRESULT; stdcall; + //CW@13/11/2011 : manually erplaced parameter declaration : "apObj: PAIWbemObjectAccess;" to allow return of array of interfaces + function GetObjects(lFlags: Longint; uNumObjects: ULONG; apObj: PAIWbemObjectAccess; out puReturned: ULONG): HRESULT; stdcall; function RemoveAll(lFlags: Longint): HRESULT; stdcall; end; {$EXTERNALSYM IWbemHiPerfEnum} Modified: jwapi/branches/2.4a/Win32API/JwaWbemCli.pas =================================================================== --- jwapi/branches/2.4a/Win32API/JwaWbemCli.pas 2011-10-27 11:38:49 UTC (rev 1108) +++ jwapi/branches/2.4a/Win32API/JwaWbemCli.pas 2011-11-13 10:33:33 UTC (rev 1109) @@ -1101,11 +1101,16 @@ PLongint = ^Longint; // TODO PLongint introduced in Delphi 6 + //CW: Make sure you deactivate range checking when using this array + TAIWbemObjectAccess = array [0..ANYSIZE_ARRAY - 1] of IWbemObjectAccess; //manually inserted declaration; not part of windows header + PAIWbemObjectAccess = ^TAIWbemObjectAccess; //manually inserted declaration; not part of windows header + IWbemHiPerfEnum = interface(IUnknown) ['{2705C288-79AE-11d2-B348-00105A1F8177}'] function AddObjects(lFlags: Longint; uNumObjects: ULONG; apIds: PLongint; apObj: PIWbemObjectAccess): HRESULT; stdcall; function RemoveObjects(lFlags: Longint; uNumObjects: ULONG; apIds: PLongint): HRESULT; stdcall; - function GetObjects(lFlags: Longint; uNumObjects: ULONG; out apObj: IWbemObjectAccess; out puReturned: ULONG): HRESULT; stdcall; + //CW@13/11/2011 : manually erplaced parameter declaration : "apObj: PAIWbemObjectAccess;" to allow return of array of interfaces + function GetObjects(lFlags: Longint; uNumObjects: ULONG; apObj: PAIWbemObjectAccess; out puReturned: ULONG): HRESULT; stdcall; function RemoveAll(lFlags: Longint): HRESULT; stdcall; end; {$EXTERNALSYM IWbemHiPerfEnum} Added: jwapi/trunk/Examples/KTM/ExecutionLevel_AsInvoker.RES =================================================================== (Binary files differ) Property changes on: jwapi/trunk/Examples/KTM/ExecutionLevel_AsInvoker.RES ___________________________________________________________________ Added: svn:mime-type + application/octet-stream Added: jwapi/trunk/Examples/KTM/GetFolderDialogU.pas =================================================================== --- jwapi/trunk/Examples/KTM/GetFolderDialogU.pas (rev 0) +++ jwapi/trunk/Examples/KTM/GetFolderDialogU.pas 2011-11-13 10:33:33 UTC (rev 1109) @@ -0,0 +1,75 @@ +//original code: http://www.scalabium.com/faq/dct0157.htm +{$I ..\..\Includes\jproject\jedi.inc} + +unit GetFolderDialogU; + +interface + +uses SysUtils; + +function GetFolderDialog (Handle: Integer; Caption: string; + var strFolder: TFileName) : Boolean; + +implementation + +uses Windows, ShlObj; + +function BrowseCallbackProc (hwnd: HWND; uMsg: UINT; lParam: LPARAM; + lpData: LPARAM): Integer; stdcall; +begin + if (uMsg = BFFM_INITIALIZED) then + SendMessage(hwnd, BFFM_SETSELECTION, 1, lpData); + + BrowseCallbackProc := 0; +end; + +function GetFolderDialog (Handle: Integer; Caption: string; + var strFolder: TFileName) : Boolean; +const + BIF_STATUSTEXT = $0004; + BIF_NEWDIALOGSTYLE = $0040; + BIF_RETURNONLYFSDIRS = $0080; + BIF_SHAREABLE = $0100; + BIF_USENEWUI = BIF_EDITBOX or BIF_NEWDIALOGSTYLE; + +var + BrowseInfo: TBrowseInfo; + ItemIDList: PItemIDList; + JtemIDList: PItemIDList; + Path: PChar; +begin + Result := False; + Path := StrAlloc(MAX_PATH); + SHGetSpecialFolderLocation(Handle, CSIDL_DRIVES, JtemIDList); + + FillChar (BrowseInfo, SizeOf (TBrowseInfo), #0); + + with BrowseInfo do + begin + hwndOwner := GetActiveWindow; + pidlRoot := JtemIDList; + SHGetSpecialFolderLocation(hwndOwner, CSIDL_DRIVES, JtemIDList); + + { return display name of item selected } + pszDisplayName := StrAlloc(MAX_PATH); + + { set the title of dialog } + lpszTitle := PChar(Caption);//'Select the folder'; + { flags that control the return stuff } + lpfn := TFNBFFCallBack (@BrowseCallbackProc); + { extra info that's passed back in callbacks } + lParam := LongInt(PChar(strFolder)); + end; + + ItemIDList := SHBrowseForFolder(BrowseInfo); + + if (ItemIDList <> nil) then + if SHGetPathFromIDList(ItemIDList, Path) then + begin + strFolder := Path; + Result := True + end; +end; + +end. + Added: jwapi/trunk/Examples/KTM/MainFormU.dfm =================================================================== --- jwapi/trunk/Examples/KTM/MainFormU.dfm (rev 0) +++ jwapi/trunk/Examples/KTM/MainFormU.dfm 2011-11-13 10:33:33 UTC (rev 1109) @@ -0,0 +1,185 @@ +object DemoForm: TDemoForm + Left = 46 + Top = 159 + ActiveControl = SelectDemoFolderBtn + BorderIcons = [biSystemMenu, biMinimize] + BorderStyle = bsSingle + Caption = 'NTFS Transaktions Demo' + ClientHeight = 557 + ClientWidth = 618 + Color = clBtnFace + Font.Charset = ANSI_CHARSET + Font.Color = clWindowText + Font.Height = -13 + Font.Name = 'Tahoma' + Font.Style = [] + OldCreateOrder = False + Position = poScreenCenter + OnCreate = FormCreate + OnDestroy = FormDestroy + PixelsPerInch = 96 + TextHeight = 16 + object Label1: TLabel + Left = 12 + Top = 232 + Width = 214 + Height = 16 + Caption = '&Folder content within the transaction:' + FocusControl = TransactedViewLB + end + object Label2: TLabel + Left = 312 + Top = 232 + Width = 236 + Height = 16 + Caption = 'F&older content outside of the transaction:' + FocusControl = NormalViewLB + end + object DemoOrdnerGB: TGroupBox + Left = 12 + Top = 16 + Width = 593 + Height = 57 + Caption = ' Test folder ' + TabOrder = 0 + object DemoFolderEdit: TEdit + Left = 12 + Top = 20 + Width = 385 + Height = 24 + Color = clBtnFace + ReadOnly = True + TabOrder = 0 + end + object SelectDemoFolderBtn: TButton + Left = 404 + Top = 20 + Width = 85 + Height = 25 + Caption = '&Select' + TabOrder = 1 + OnClick = SelectDemoFolderBtnClick + end + object ExplorerBtn: TButton + Left = 496 + Top = 20 + Width = 85 + Height = 25 + Caption = 'E&xplorer' + Enabled = False + TabOrder = 2 + OnClick = ExplorerBtnClick + end + end + object TransactionsGB: TGroupBox + Left = 12 + Top = 88 + Width = 291 + Height = 129 + Caption = ' Transaction ' + TabOrder = 1 + object NewTransactionBtn: TButton + Left = 12 + Top = 20 + Width = 125 + Height = 25 + Caption = '&New Transaction' + TabOrder = 0 + OnClick = NewTransactionBtnClick + end + object CommitTransactionBtn: TButton + Left = 12 + Top = 56 + Width = 265 + Height = 25 + Caption = 'Transaction "&Commit"' + Enabled = False + TabOrder = 2 + OnClick = CommitTransactionBtnClick + end + object RollbackTransactionBtn: TButton + Left = 12 + Top = 92 + Width = 265 + Height = 25 + Caption = 'Transaction "&Rollback"' + Enabled = False + TabOrder = 3 + OnClick = RollbackTransactionBtnClick + end + object NewTimeoutBtn: TButton + Left = 152 + Top = 20 + Width = 125 + Height = 25 + Caption = 'N&ew with Timeout' + TabOrder = 1 + OnClick = NewTransactionBtnClick + end + end + object OperationsGB: TGroupBox + Left = 314 + Top = 88 + Width = 291 + Height = 129 + Caption = ' Actions within the Transaction ' + TabOrder = 2 + object CreateFileBtn: TButton + Left = 12 + Top = 20 + Width = 265 + Height = 25 + Caption = 'Crea&te file' + TabOrder = 0 + OnClick = CreateFileBtnClick + end + object RenameFilesBtn: TButton + Left = 12 + Top = 56 + Width = 265 + Height = 25 + Caption = 'Ren&ame file(s)' + TabOrder = 1 + OnClick = RenameFilesBtnClick + end + object DeleteFilesBtn: TButton + Left = 12 + Top = 92 + Width = 265 + Height = 25 + Caption = '&Delete file(s)' + TabOrder = 2 + OnClick = DeleteFilesBtnClick + end + end + object TransactedViewLB: TListBox + Left = 12 + Top = 248 + Width = 291 + Height = 277 + Sorted = True + TabOrder = 3 + end + object NormalViewLB: TListBox + Left = 314 + Top = 248 + Width = 291 + Height = 277 + Sorted = True + TabOrder = 4 + end + object StatusBar: TStatusBar + Left = 0 + Top = 538 + Width = 618 + Height = 19 + Panels = <> + SimplePanel = True + end + object TransactionTimer: TTimer + Enabled = False + OnTimer = TransactionTimerTimer + Left = 24 + Top = 264 + end +end Added: jwapi/trunk/Examples/KTM/MainFormU.pas =================================================================== --- jwapi/trunk/Examples/KTM/MainFormU.pas (rev 0) +++ jwapi/trunk/Examples/KTM/MainFormU.pas 2011-11-13 10:33:33 UTC (rev 1109) @@ -0,0 +1,533 @@ +{******************************************************************************} +{ JEDI File Transactions API example } +{ http://jedi-apilib.sourceforge.net } +{ http://wiki.delphi-jedi.org/ } +{ http://blog.delphi-jedi.net/ } +{ } +{ Obtained through: Joint Endeavour of Delphi Innovators (Project JEDI) } +{ } +{ Author(s): Olaf Hess (olafhess at newsguy dot com) } +{ Creation date: December 1st 2009 } +{ Last modification date: November 28th 2010 } +{ } +{ Description: Demonstrates how to use the file system transactions introduced } +{ with Windows Vista / Server 2008 } +{ } +{ Preparations: JWA must be ready to use. } +{ } +{ Version history: December 1st 2009: initial version } +{ November 28th 2010: adapted to use JWA } +{ } +{ No license. Use this example with no warranty at all and on your own risk. } +{ This example is just for learning purposes and should not be used in } +{ production environments. } +{******************************************************************************} + +//----------------------------------------------------------------------------// +// This code was first published as part of the article // +// "Transaktionen mit Vista und NTFS" ("Transactions with Vista and NTFS") // +// in issue 1 / 2010 of "Toolbox Magazin" (http://www.toolbox-mag.de) written // +// by Olaf Hess. Used with permission. Donated to the JEDI API Project. // +//----------------------------------------------------------------------------// + +// This program uses the "TShellChangeNotifier" component. If you on loading +// this form see an error message that it is missing please install the +// "ShellControls" package from the "ShellControls" folder in the "Demos" +// folder of your Delphi installation (search for "ShellCtrls.pas"). + +{$I ..\..\Includes\jproject\jedi.inc} + +{$IFDEF DELPHI7_UP} + {$WARN UNIT_PLATFORM OFF} +{$ENDIF} + +unit MainFormU; + +interface + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, + Dialogs, StdCtrls, SyncObjs, + TransactionClassU, ComCtrls, ExtCtrls, ShellCtrls; + +type + TDemoForm = class(TForm) + DemoOrdnerGB: TGroupBox; + DemoFolderEdit: TEdit; + SelectDemoFolderBtn: TButton; + ExplorerBtn: TButton; + TransactionsGB: TGroupBox; + OperationsGB: TGroupBox; + NewTransactionBtn: TButton; + CommitTransactionBtn: TButton; + RollbackTransactionBtn: TButton; + CreateFileBtn: TButton; + RenameFilesBtn: TButton; + DeleteFilesBtn: TButton; + TransactedViewLB: TListBox; + NormalViewLB: TListBox; + Label1: TLabel; + Label2: TLabel; + NewTimeoutBtn: TButton; + StatusBar: TStatusBar; + TransactionTimer: TTimer; + ShellChangeNotifier: TShellChangeNotifier; + + procedure FormCreate(Sender: TObject); + procedure NewTransactionBtnClick(Sender: TObject); + procedure FormDestroy(Sender: TObject); + procedure CommitTransactionBtnClick(Sender: TObject); + procedure RollbackTransactionBtnClick(Sender: TObject); + procedure SelectDemoFolderBtnClick(Sender: TObject); + procedure ExplorerBtnClick(Sender: TObject); + procedure CreateFileBtnClick(Sender: TObject); + procedure RenameFilesBtnClick(Sender: TObject); + procedure DeleteFilesBtnClick(Sender: TObject); + procedure TransactionTimerTimer(Sender: TObject); + procedure ShellChangeNotifierChange; + + private + Transaction : TTransaction; + CS : TCriticalSection; + + procedure EnableOperationsButtons (const bEnable: Boolean); + procedure ChangeTransactionButtonsStatus (const bInProgress: Boolean); + procedure Update_Left_LB; + procedure Update_Right_LB; + + public + { Public declarations } + end; + +var + DemoForm : TDemoForm; + +function GetAppTitle : String; + +implementation + +{$R *.dfm} + +uses StrUtils, + GetFolderDialogU; + +(* ---- *) + +function GetAppTitle : String; +begin + Result := ExtractFileName (ParamStr (0)); +end; { GetAppTitle } + +(* ---- *) + +procedure TDemoForm.FormCreate (Sender: TObject); +begin + Application.Title := Caption; + CS := TCriticalSection.Create; + + EnableOperationsButtons (false); +end; { TDemoForm.FormCreate } + +(* ---- *) + +procedure TDemoForm.FormDestroy (Sender: TObject); +begin + if (Assigned (Transaction)) then + Transaction.Free; + + CS.Free; +end; { TDemoForm.FormDestroy } + +(* ---- *) + +procedure TDemoForm.SelectDemoFolderBtnClick (Sender: TObject); + +var + sDemoFolder : TFileName; + +begin + sDemoFolder := ExtractFileDir (Application.ExeName); + + if (GetFolderDialog (Handle, 'Select test folder', sDemoFolder)) then + begin + sDemoFolder := IncludeTrailingPathDelimiter (sDemoFolder) + + 'TestFolder'; + + if not (DirectoryExists (sDemoFolder)) then + if (MessageDlg (Format ('Create folder "%s"?', [sDemoFolder]), + mtConfirmation, [mbYes, mbNo], 0) = mrYes) then + begin + if not (CreateDir (sDemoFolder)) then + begin + MessageDlg (Format ('Error creating folder "%s"!', + [sDemoFolder]), + mtError, [mbOK], 0); + exit; + end; { if } + end { if } + else exit; + + DemoFolderEdit.Text := sDemoFolder; + ExplorerBtn.Enabled := true; + NewTransactionBtn.SetFocus; + SelectDemoFolderBtn.Enabled := false; + + Update_Left_LB; + Update_Right_LB; + + ShellChangeNotifier.Root := sDemoFolder; + ShellChangeNotifier.OnChange := ShellChangeNotifierChange; + end; { if } +end; { TDemoForm.SelectDemoFolderBtnClick } + +(* ---- *) + +procedure TDemoForm.ExplorerBtnClick (Sender: TObject); + +const + cCmdLine = 'explorer.exe "%s"'; + +var + sCmdLine : AnsiString; + +begin + sCmdLine := AnsiString (Format (cCmdLine, [DemoFolderEdit.Text])); + WinExec (PAnsiChar (sCmdLine), sw_Show); +end; { TDemoForm.ExplorerBtnClick } + +(* ---- *) + +procedure TDemoForm.NewTransactionBtnClick (Sender: TObject); + + (* ---- *) + + function GetTimeout (out dwTimeout: DWord) : Boolean; + + var + sTimeout : String; + iTimeout : Integer; + + begin + repeat + sTimeout := '0'; + Result := InputQuery ('Create transaction with timeout', + 'Timeout (seconds):', sTimeout); + + if not (Result) then + exit; + + iTimeout := StrToIntDef (sTimeout, 0); + + Result := iTimeout > 0; + + if (Result) then + dwTimeout := DWord (iTimeout) + else MessageDlg ('Please enter a number greater 0!', + mtError, [mbOK], 0); + until (Result); + end; { GetTimeout } + + (* ---- *) + +const + cAbortMsg = 'Please be aware that the transaction will automatically get ' + + 'aborted after %d seconds'#13'unless you perform a "Commit" ' + + 'before that period expires!'; + +var + dwTimeout : DWord; + +begin { TDemoForm.NewTransactionBtnClick } + if (DemoFolderEdit.Text = '') then + begin + MessageDlg ('No "test folder" selected!', mtError, [mbOK], 0); + SelectDemoFolderBtn.SetFocus; + exit; + end; { if } + + if (Assigned (Transaction)) then + begin + MessageDlg ('Transaction <> NIL', mtError, [mbOK], 0); + exit; + end; { if } + + if (Sender = NewTimeoutBtn) then + begin + if not (GetTimeout (dwTimeout)) then + exit; + + MessageDlg (Format (cAbortMsg, [dwTimeout]), mtInformation, [mbOK], 0); + + Transaction := TTransaction.CreateTimeout (Caption, dwTimeout * 1000); + + TransactionTimer.Enabled := true; + end { if} + else + begin + Transaction := TTransaction.Create (Caption); + StatusBar.SimpleText := Format (' Transaction "%s" created', [Caption]) + end; { else } + + ChangeTransactionButtonsStatus (true); +end; { TDemoForm.NewTransactionBtnClick } + +(* ---- *) + +procedure TDemoForm.CommitTransactionBtnClick (Sender: TObject); +begin + try + Transaction.Commit; + + finally + FreeAndNil (Transaction); + ChangeTransactionButtonsStatus (false); + end; { try / finally } +end; { TDemoForm.CommitTransactionBtnClick } + +(* ---- *) + +procedure TDemoForm.RollbackTransactionBtnClick (Sender: TObject); +begin + try + Transaction.Rollback; + + finally + FreeAndNil (Transaction); + ChangeTransactionButtonsStatus (false); + end; { try / finally } +end; { TDemoForm.RollbackTransactionBtnClick } + +(* ---- *) + +procedure TDemoForm.CreateFileBtnClick (Sender: TObject); + + (* ---- *) + + function GetNewFileName : TFileName; + + var + iCount : Integer; + sFileName : TFileName; + + begin + iCount := 0; + + repeat + Inc (iCount); + + sFileName := Format ('File%3.d.txt', [iCount]); + sFileName := AnsiReplaceStr (sFileName, ' ', '0'); + + Result := Format ('%s\%s', [DemoFolderEdit.Text, sFileName]); + until (Transaction.FileExists (Result) = false); + end; { GetNewFileName } + + (* ---- *) + +var + sNewFileName : TFileName; + hFile : Integer; + +begin { TDemoForm.CreateFileBtnClick } + sNewFileName := GetNewFileName; + + hFile := Transaction.FileCreate (sNewFileName); + + if (FileWrite (hFile, PChar (sNewFileName)^, + Length (sNewFileName)) <> (-1)) then + FileClose (hFile); + + Update_Left_LB; +end; { TDemoForm.CreateFileBtnClick } + +(* ---- *) + +procedure TDemoForm.RenameFilesBtnClick (Sender: TObject); + +var + iIndex, iPos : Integer; + sDir, sNewName : TFileName; + +begin + sDir := DemoFolderEdit.Text + '\'; + + with TransactedViewLB do + if (Items.Count = 0) then + MessageDlg ('No files found!', mtError, [mbOK], 0) + else + begin + for iIndex := 0 to Items.Count - 1 do + begin + sNewName := Items [iIndex]; + + iPos := Pos ('.', sNewName); + + if (iPos = 0) then + Continue; + + Insert (Char (iIndex + $61), sNewName, iPos); + + Transaction.MoveFile (sDir + Items [iIndex], sDir + sNewName); + end; { for } + + Update_Left_LB; + end; { else } +end; { TDemoForm.RenameFilesBtnClick } + +(* ---- *) + +procedure TDemoForm.DeleteFilesBtnClick (Sender: TObject); + +var + iIndex : Integer; + sDir : TFileName; + +begin + sDir := DemoFolderEdit.Text + '\'; + + with TransactedViewLB do + if (Items.Count = 0) then + MessageDlg ('No files found!', mtError, [mbOK], 0) + else + begin + for iIndex := 0 to Items.Count - 1 do + Transaction.DeleteFile (sDir + Items [iIndex]); + + Update_Left_LB; + end; { else } +end; { TDemoForm.DeleteFilesBtnClick } + +(* ---- *) + +procedure TDemoForm.TransactionTimerTimer (Sender: TObject); + +const + cStatusMsg = ' Time since start of the transaction: %d seconds'; + +begin + with TransactionTimer do + begin + Tag := Tag + 1; + StatusBar.SimpleText := Format (cStatusMsg, [Tag]); + end; { with } +end; { TDemoForm.TimerTimer } + +(* ---- *) + +procedure TDemoForm.ShellChangeNotifierChange; +begin + Update_Right_LB; +end; { TDemoForm.ShellChangeNotifierChange } + +(* ---- *) + +procedure TDemoForm.EnableOperationsButtons (const bEnable: Boolean); +begin + CreateFileBtn.Enabled := bEnable; + RenameFilesBtn.Enabled := bEnable; + DeleteFilesBtn.Enabled := bEnable; +end; { TDemoForm.EnableOperationsButtons } + +(* ---- *) + +procedure TDemoForm.ChangeTransactionButtonsStatus (const bInProgress: Boolean); + + (* ---- *) + + procedure ResetTimer; + begin + TransactionTimer.Enabled := false; + TransactionTimer.Tag := 0; + + StatusBar.SimpleText := ''; + end; { ResetTimer } + + (* ---- *) + +begin + if (bInProgress) then + begin + EnableOperationsButtons (true); + CreateFileBtn.SetFocus; + + NewTransactionBtn.Enabled := false; + NewTimeoutBtn.Enabled := false; + + CommitTransactionBtn.Enabled := true; + RollbackTransactionBtn.Enabled := true; + end { if } + else + begin + ResetTimer; + + NewTransactionBtn.Enabled := true; + NewTransactionBtn.SetFocus; + NewTimeoutBtn.Enabled := true; + + CommitTransactionBtn.Enabled := false; + RollbackTransactionBtn.Enabled := false; + + EnableOperationsButtons (false); + end; { else } + + Update_Left_LB; +end; { TDemoForm.ChangeTransactionButtonsStatus } + +(* ---- *) + +procedure TDemoForm.Update_Left_LB; + +var + SearchRec : TSearchRec; + +begin + TransactedViewLB.Items.Clear; + + if (Assigned (Transaction)) then + begin + FillChar (SearchRec, SizeOf (TSearchRec), #0); + + if (Transaction.FindFirst (DemoFolderEdit.Text + '\*.*', faAnyFile, + SearchRec) = 0) then + repeat + if (SearchRec.Attr and faDirectory = 0) then + TransactedViewLB.Items.Add (SearchRec.Name); + until (FindNext (SearchRec) <> 0); + + FindClose (SearchRec); + end; { if } +end; { TDemoForm.Update_Left_LB } + +(* ---- *) + +procedure TDemoForm.Update_Right_LB; + +var + SearchRec : TSearchRec; + +begin + CS.Acquire; + + try + NormalViewLB.Items.Clear; + + FillChar (SearchRec, SizeOf (TSearchRec), #0); + + if (FindFirst (DemoFolderEdit.Text + '\*.*', faAnyFile, + SearchRec) = 0) then + repeat + if (SearchRec.Attr and faDirectory = 0) then + NormalViewLB.Items.Add (SearchRec.Name); + until (FindNext (SearchRec) <> 0); + + FindClose (SearchRec); + + finally + CS.Release; + end; { try / finally } +end; { TDemoForm.Update_Right_LB } + +(* ---- *) + +end. + Added: jwapi/trunk/Examples/KTM/TransactionClassU.pas =================================================================== --- jwapi/trunk/Examples/KTM/TransactionClassU.pas (rev 0) +++ jwapi/trunk/Examples/KTM/TransactionClassU.pas 2011-11-13 10:33:33 UTC (rev 1109) @@ -0,0 +1,452 @@ +{******************************************************************************} +{ JEDI File Transactions API example } +{ http://jedi-apilib.sourceforge.net } +{ http://wiki.delphi-jedi.org/ } +{ http://blog.delphi-jedi.net/ } +{ } +{ Obtained through: Joint Endeavour of Delphi Innovators (Project JEDI) } +{ } +{ Author(s): Olaf Hess (olafhess at newsguy dot com) } +{ Creation date: December 1st 2009 } +{ Last modification date: November 28th 2010 } +{ } +{ Description: Demonstrates how to use the file system transactions introduced } +{ with Windows Vista / Server 2008 } +{ } +{ Preparations: JWA must be ready to use. } +{ } +{ Version history: December 1st 2009: initial version } +{ November 28th 2010: adapted to use JWA } +{ } +{ No license. Use this example with no warranty at all and on your own risk. } +{ This example is just for learning purposes and should not be used in } +{ production environments. } +{******************************************************************************} + +//----------------------------------------------------------------------------// +// This code was first published as part of the article // +// "Transaktionen mit Vista und NTFS" ("Transactions with Vista and NTFS") // +// in issue 1 / 2010 of "Toolbox Magazin" (http://www.toolbox-mag.de) written // +// by Olaf Hess. Used with permission. Donated to the JEDI API Project. // +//----------------------------------------------------------------------------// + +{$I ..\..\Includes\jproject\jedi.inc} + +{$IFDEF DELPHI7_UP} + {$WARN SYMBOL_PLATFORM OFF} + {$WARN SYMBOL_DEPRECATED OFF} +{$ENDIF} + +unit TransactionClassU; + +interface + +uses SysUtils, +{$IFDEF JWA_WINDOWS} + JwaWindows; +{$ELSE} + JwaWinBase, JwaWinType; +{$ENDIF JWA_WINDOWS} + +type + ETransactionError = class (Exception); + + TCopyFileFlag = (cffCopySymlink, cffFailIfExists, cffOpenSourceForWrite, + cffFileRestartable); + TCopyFileFlags = set of TCopyFileFlag; + + TMoveFileFlag = (mffReplaceExisting, mffCopyAllowed, mffDelayUntilReboot, + mffWriteThrough, mffCreateHardLink, mffFailIfNotTrackable); + TMoveFileFlags = set of TMoveFileFlag; + + TTransaction = class + private + FHandle : THandle; + bRaiseExceptions : Boolean; + + public + constructor Create (const sDescription: WideString; + const bRaiseExceptions: Boolean = true); + constructor CreateTimeout (const sDescription: WideString; + const dwTimeoutMSec: DWord; + const bRaiseExceptions: Boolean = true); + destructor Destroy; override; + + function Commit : Boolean; + function Rollback : Boolean; + + function CopyFile (const sExistingFile, sNewFile: TFileName; + const CopyFileFlags: TCopyFileFlags = []) : Boolean; + + function DeleteFile (const sFileName: TFileName) : Boolean; + + function DirectoryExists (const sDirectory: TFileName) : Boolean; + + function FileCreate (const sFileName: String) : Integer; + + function FileExists (const sFileName: TFileName) : Boolean; + + function FileOpen (const sFileName: String; + const Mode: LongWord) : Integer; + + function FileGetAttr (const sFileName: String) : Integer; + + function FindFirst (const sPath: String; const iAttr: Integer; + var F: TSearchRec) : Integer; + + function MoveFile (const sExistingFile, sNewFile: TFileName; + const MoveFileFlags: TMoveFileFlags = []) : Boolean; + + function RemoveDir (const sDir: TFileName) : Boolean; + + property Handle : THandle read FHandle; + end; { TTransaction } + +implementation + +uses +{$IFNDEF JWA_WINDOWS} + JwaNative, JwaWinnt, +{$ENDIF JWA_WINDOWS} + JwaKtmW32; + +(* ---- *) + +constructor TTransaction.Create (const sDescription: WideString; + const bRaiseExceptions: Boolean = true); +begin + CreateTimeout (sDescription, 0, bRaiseExceptions); +end; { TTransaction.Create } + +(* ---- *) + +constructor TTransaction.CreateTimeout (const sDescription: WideString; + const dwTimeoutMSec: DWord; + const bRaiseExceptions: Boolean); +var + psDescription : PWideChar; + +begin + if (sDescription <> '') then + psDescription := PWideChar (sDescription) + else psDescription := NIL; + + FHandle := CreateTransaction (NIL, NIL, 0, 0, 0, dwTimeoutMSec, + psDescription); + + Win32Check (FHandle <> INVALID_HANDLE_VALUE); + + Self.bRaiseExceptions := bRaiseExceptions; +end; { TTransaction.CreateTimeout } + +(* ---- *) + +destructor TTransaction.Destroy; + +var + bResult : Boolean; + +begin + if (FHandle <> INVALID_HANDLE_VALUE) then + begin + // Rolls back the transaction if not commited + bResult := CloseHandle (FHandle); + + if (bResult = false) and (bRaiseExceptions) then + RaiseLastWin32Error; + end; { if } + + inherited; +end; { TTransaction.Destroy } + +(* ---- *) + +function TTransaction.Commit : Boolean; +begin + Result := CommitTransaction (FHandle); + + if (Result) then + begin + CloseHandle (FHandle); + FHandle := INVALID_HANDLE_VALUE; + end; { if } + + if (Result = false) and (bRaiseExceptions) then + RaiseLastWin32Error; +end; { TTransaction.Commit } + +(* ---- *) + +function TTransaction.Rollback : Boolean; +begin + Result := RollbackTransaction (FHandle); + + if (Result) then + begin + CloseHandle (FHandle); + FHandle := INVALID_HANDLE_VALUE; + end; { if } + + if (Result = false) and (bRaiseExceptions) then + RaiseLastWin32Error; +end; { TTransaction.Rollback } + +(* ---- *) + +function TTransaction.CopyFile (const sExistingFile, sNewFile: TFileName; + const CopyFileFlags: TCopyFileFlags) : Boolean; + +const + cCopyFileFlags : array [TCopyFileFlag] of DWord = + (COPY_FILE_COPY_SYMLINK, COPY_FILE_FAIL_IF_EXISTS, + COPY_FILE_OPEN_SOURCE_FOR_WRITE, COPY_FILE_RESTARTABLE); + +var + dwFlags : DWord; + CopyFileFlag : TCopyFileFlag; + +begin + Assert ((sExistingFile <> '') and (sNewFile <> '')); + + dwFlags := 0; + + if (CopyFileFlags <> []) then + for CopyFileFlag := Low (TCopyFileFlag) to High (TCopyFileFlag) do + if (CopyFileFlag in CopyFileFlags) then + dwFlags := dwFlags or cCopyFileFlags [CopyFileFlag]; + + Result := CopyFileTransacted (PChar (sExistingFile), PChar (sNewFile), NIL, + NIL, NIL, dwFlags, FHandle); + + if (Result = false) and (bRaiseExceptions) then + RaiseLastWin32Error; +end; { TTransaction.CopyFile } + +(* ---- *) + +function TTransaction.DeleteFile (const sFileName: TFileName) : Boolean; +begin + Result := DeleteFileTransacted (PChar (sFileName), FHandle); + + if (Result = false) and (bRaiseExceptions) then + RaiseLastWin32Error; +end; { TTransaction.DeleteFile } + +(* ---- *) + +function TTransaction.DirectoryExists (const sDirectory: TFileName) : Boolean; + +var + FileInfo : TWin32FileAttributeData; + +begin + if (GetFileAttributesTransacted (PChar (sDirectory), GetFileExInfoStandard, + FileInfo, FHandle)) then + Result := (FileInfo.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = + FILE_ATTRIBUTE_DIRECTORY + else Result := false; +end; { TTransaction.DirectoryExists } + +(* ---- *) + +function TTransaction.FileCreate (const sFileName: String) : Integer; + +var + hResult : THandle; + +begin + hResult := CreateFileTransacted (PChar (sFileName), + GENERIC_READ or GENERIC_WRITE, 0, NIL, + CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0, + FHandle, NIL, NIL); + + Result := Integer (hResult); + + if (hResult = INVALID_HANDLE_VALUE) and (bRaiseExceptions) then + RaiseLastWin32Error; +end; { TTransaction.FileCreate } + +(* ---- *) + +function TTransaction.FileExists (const sFileName: TFileName) : Boolean; + +var + FileInfo : TWin32FileAttributeData; + +begin + if (GetFileAttributesTransacted (PChar (sFileName), GetFileExInfoStandard, + FileInfo, FHandle)) then + Result := (FileInfo.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) <> + FILE_ATTRIBUTE_DIRECTORY + else Result := false; +end; { TTransaction.FileExists } + +(* ---- *) + +function TTransaction.FileOpen (const sFileName: String; + const Mode: LongWord) : Integer; + +const + AccessMode : array [0..2] of LongWord = (GENERIC_READ, + GENERIC_WRITE, + GENERIC_READ or GENERIC_WRITE); + ShareMode : array [0..4] of LongWord = (0, + 0, + FILE_SHARE_READ, + FILE_SHARE_WRITE, + FILE_SHARE_READ or FILE_SHARE_WRITE); + +var + hResult : THandle; + +begin + hResult := INVALID_HANDLE_VALUE; + + if ((Mode and 3) <= fmOpenReadWrite) and + ((Mode and $F0) <= fmShareDenyNone) then + hResult := CreateFileTransacted (PChar (sFileName), + AccessMode [Mode and 3], + ShareMode [(Mode and $F0) shr 4], + NIL, OPEN_EXISTING, + FILE_ATTRIBUTE_NORMAL, 0, FHandle, NIL, + NIL); + + Result := Integer (hResult); + + if (hResult = INVALID_HANDLE_VALUE) and (bRaiseExceptions) then + RaiseLastWin32Error; +end; { TTransaction.FileOpen } + +(* ---- *) + +function TTransaction.FileGetAttr (const sFileName: String) : Integer; + +var + FileInfo : TWin32FileAttributeData; + +begin + if (GetFileAttributesTransacted (PChar (sFileName), GetFileExInfoStandard, + FileInfo, FHandle)) then + Result := Integer (FileInfo.dwFileAttributes) + else + begin + Result := (-1); + + if (bRaiseExceptions) then + RaiseLastWin32Error; + end; { if }; +end; { TTransaction.FileGetAttr } + +(* ---- *) + +function TTransaction.FindFirst (const sPath: String; const iAttr: Integer; + var F: TSearchRec) : Integer; + + (* ---- *) + + function FindMatchingFile (var F: TSearchRec) : Integer; + + type +{$IFDEF JWA_WINDOWS} + TFileTime = JwaWindows.TFileTime; +{$ELSE} + TFileTime = JwaWinBase.TFileTime; +{$ENDIF JWA_WINDOWS} +// TFileTime = Windows.TFileTime; + + var + LocalFileTime : TFileTime; + + begin + with F do + begin + while (FindData.dwFileAttributes and ExcludeAttr <> 0) do + if not (FindNextFile (FindHandle, + TWin32FindData (FindData))) then + begin + Result := GetLastError; + exit; + end; { if } + + FileTimeToLocalFileTime (TFileTime (FindData.ftLastWriteTime), + TFileTime (LocalFileTime)); + FileTimeToDosDateTime (TFileTime (LocalFileTime), + LongRec (Time).Hi, LongRec (Time).Lo); + + Size := FindData.nFileSizeLow; + Attr := FindData.dwFileAttributes; + Name := FindData.cFileName; + end; { with } + + Result := 0; + end; { FindMatchingFile } + + (* ---- *) + +const + faSpecial = faHidden or faSysFile or faVolumeID or faDirectory; + +begin + Assert (sPath <> ''); + + F.ExcludeAttr := not iAttr and faSpecial; + F.FindHandle := FindFirstFileTransacted (PChar (sPath), FindExInfoStandard, + TWin32FindData (F.FindData), + FindExSearchNameMatch, NIL, 0, + FHandle); + + if (F.FindHandle <> INVALID_HANDLE_VALUE) then + begin + Result := FindMatchingFile (F); + + if (Result <> 0) then + SysUtils.FindClose (F); + end { if } + else Result := GetLastError; +end; { TTransaction.FindFirst } + +(* ---- *) + +function TTransaction.MoveFile (const sExistingFile, sNewFile: TFileName; + const MoveFileFlags: TMoveFileFlags) : Boolean; + +const + cMoveFileFlags : array [TMoveFileFlag] of DWord = + (MOVEFILE_REPLACE_EXISTING, MOVEFILE_COPY_ALLOWED, + MOVEFILE_DELAY_UNTIL_REBOOT, MOVEFILE_WRITE_THROUGH, + MOVEFILE_CREATE_HARDLINK, MOVEFILE_FAIL_IF_NOT_TRACKABLE); + +var + dwFlags : DWord; + MoveFileFlag : TMoveFileFlag; + +begin + Assert ((sExistingFile <> '') and (sNewFile <> '')); + + dwFlags := 0; + + if (MoveFileFlags <> []) then + for MoveFileFlag := Low (TMoveFileFlag) to High (TMoveFileFlag) do + if (MoveFileFlag in MoveFileFlags) then + dwFlags := dwFlags or cMoveFileFlags [MoveFileFlag]; + + Result := MoveFileTransacted (PChar (sExistingFile), PChar (sNewFile), + NIL, NIL, dwFlags, FHandle); + + if (Result = false) and (bRaiseExceptions) then + RaiseLastWin32Error; +end; { TTransaction.MoveFile } + +(* ---- *) + +function TTransaction.RemoveDir (const sDir: TFileName) : Boolean; +begin + Result := RemoveDirectoryTransacted (PChar (sDir), FHandle); + + if (Result = false) and (bRaiseExceptions) then + RaiseLastWin32Error; +end; { TTransaction.RemoveDir } + +(* ---- *) + +end. Added: jwapi/trunk/Examples/KTM/TransactionsDemo.dpr =================================================================== --- jwapi/trunk/Examples/KTM/TransactionsDemo.dpr (rev 0) +++ jwapi/trunk/Examples/KTM/TransactionsDemo.dpr 2011-11-13 10:33:33 UTC (rev 1109) @@ -0,0 +1,78 @@ +{******************************************************************************} +{ JEDI File Transactions API example } +{ http://jedi-apilib.sourceforge.net } +{ http://wiki.delphi-jedi.org/ } +{ http://blog.delphi-jedi.net/ } +{ } +{ Obtained through: Joint Endeavour of Delphi Innovators (Project JEDI) } +{ } +{ Author(s): Olaf Hess (olafhess at newsguy dot com) } +{ Creation date: December 1st 2009 } +{ Last modification date: November 28th 2010 } +{ } +{ Description: Demonstrates how to use the file system transactions introduced } +{ with Windows Vista / Server 2008 } +{ } +{ Preparations: JWA must be ready to use. } +{ } +{ Version history: December 1st 2009: initial version } +{ November 28th 2010: adapted to use JWA } +{ } +{ No license. Use this example with no warranty at all and on your own risk. } +{ This example is just for learning purposes and should not be used in } +{ production environments. } +{******************************************************************************} + +//----------------------------------------------------------------------------// +// This code was first published as part of the article // +// "Transaktionen mit Vista und NTFS" ("Transactions with Vista and NTFS") // +// in issue 1 / 2010 of "Toolbox Magazin" (http://www.toolbox-mag.de) written // +// by Olaf Hess. Used with permission. Donated to the JEDI API Project. // +//----------------------------------------------------------------------------// + +// Program tested with Delphi 7 and Delphi 2009 + +{$I ..\..\Includes\jproject\jedi.inc} + +program TransactionsDemo; + +uses + Forms, + SysUtils, + Windows, + MainFormU in 'MainFormU.pas' {DemoForm}, + GetFolderDialogU in 'GetFolderDialogU.pas', + TransactionClassU in 'TransactionClassU.pas', + JwaKtmW32; + +{$R *.res} +{$R ExecutionLevel_AsInvoker.RES} + +(* ---- *) + +procedure CheckWindowsVersion; + +const + cWrongVersion = 'This program requires at least Windows Vista or ' + + 'Windows Server 2008!'; + +begin + if (Win32Platform <> VER_PLATFORM_WIN32_NT) or + (Win32MajorVersion < 6) then + begin + MessageBox (GetDesktopWindow, cWrongVersion, PChar (GetAppTitle), + mb_OK or mb_IconStop); + Halt (1); + end; { if } +end; { CheckWindowsVersion } + +(* ---- *) + +begin { TransactionsDemo } + CheckWindowsVersion; + + Application.Initialize; + Application.CreateForm(TDemoForm, DemoForm); + Application.Run; +end. + Added: jwapi/trunk/Examples/KTM/switches.inc =================================================================== --- jwapi/trunk/Examples/KTM/switches.inc (rev 0) +++ jwapi/trunk/Examples/KTM/switches.inc 2011-11-13 10:33:33 UTC (rev 1109) @@ -0,0 +1,281 @@ +(** + {$WARN UNSAFE_CODE OFF} + {$WARN UNSAFE_TYPE OFF} + {$WARN UNSAFE_CAST OFF} + + {$WARN SYMBOL_PLATFORM OFF} + {$WARN SYMBOL_LIBRARY OFF} + {$WARN SYMBOL_DEPRECATED OFF} + {$WARN UNIT_DEPRECATED OFF} + {$WARN UNIT_LIBRARY OFF} + {$WARN UNIT_PLATFORM OFF} +**) + +{$DEFINE BP7} +{$DEFINE DELPHI1} +{$DEFINE DELPHI2} +{$DEFINE DELPHI3} +{$DEFINE DELPHI4} +{$DEFINE DELPHI5} +{$DEFINE DELPHI6} +{$DEFINE DELPHI7} +{$DEFINE DELPHI8} +{$DEFINE DELPHI2005} +{$DEFINE DELPHI2006} +{$DEFINE DELPHI2007} +{$DEFINE DELPHI2009} +{$DEFINE DELPHI2010} +{$DEFINE DELPHI_XE} + +{* Borland Pascal 7 *} +{$IFDEF VER70} + {$UNDEF DELPHI1} + {$UNDEF DELPHI2} + {$UNDEF DELPHI3} + {$UNDEF DELPHI4} + {$UNDEF DELPHI5} + {$UNDEF DELPHI6} + {$UNDEF DELPHI7} + {$UNDEF DELPHI8} + {$UNDEF DELPHI9} + {$UNDEF DELPHI2005} + {$UNDEF DELPHI2006} + {$UNDEF DELPHI2007} + {$UNDEF DELPHI2009} + {$UNDEF DELPHI2010} + {$UNDEF DELPHI_XE} +{$ENDIF} + +{* Delphi 1.0 *} +{$IFDEF VER80} + {$UNDEF DELPHI2} + {$UNDEF DELPHI3} + {$UNDEF DELPHI4} + {$UNDEF DELPHI5} + {$UNDEF DELPHI6} + {$UNDEF DELPHI7} + {$UNDEF DELPHI8} + {$UNDEF DELPHI2005} + {$UNDEF DELPHI2006} + {$UNDEF DELPHI2007} + {$UNDEF DELPHI2009} + {$UNDEF DELPHI2010} + {$UNDEF DELPHI_XE} +{$ENDIF} + +{* Delphi 2.0 *} +{$IFDEF VER90} + {$UNDEF DELPHI3} + {$UNDEF DELPHI4} + {$UNDEF DELPHI5} + {$UNDEF DELPHI6} + {$UNDEF DELPHI7} + {$UNDEF DELPHI8} + {$UNDEF DELPHI2005} + {$UNDEF DELPHI2006} + {$UNDEF DELPHI2007} + {$UNDEF DELPHI2009} + {$UNDEF DELPHI2010} + {$UNDEF DELPHI_XE} +{$ENDIF} + +{* Delphi 3.0 *} +{$IFDEF VER100} + {$UNDEF DELPHI4} + {$UNDEF DELPHI5} + {$UNDEF DELPHI6} + {$UNDEF DELPHI7} + {$UNDEF DELPHI8} + {$UNDEF DELPHI2005} + {$UNDEF DELPHI2006} + {$UNDEF DELPHI2007} + {$UNDEF DELPHI2009} + {$UNDEF DELPHI2010} + {$UNDEF DELPHI_XE} +{$ENDIF} + +{* Delphi 4.0 *} +{$IFDEF VER120} + {$UNDEF DELPHI5} + {$UNDEF DELPHI6} + {$UNDEF DELPHI7} + {$UNDEF DELPHI8} + {$UNDEF DELPHI2005} + {$UNDEF DELPHI2006} + {$UNDEF DELPHI2007} + {$UNDEF DELPHI2009} + {$UNDEF DELPHI2010} + {$UNDEF DELPHI_XE} +{$ENDIF} + +{* Delphi 5.0 *} +{$IFDEF VER130} + {$UNDEF DELPHI6} + {$UNDEF DELPHI7} + {$UNDEF DELPHI8} + {$UNDEF DELPHI2005} + {$UNDEF DELPHI2006} + {$UNDEF DELPHI2007} + {$UNDEF DELPHI2009} + {$UNDEF DELPHI2010} + {$UNDEF DELPHI_XE} +{$ENDIF} + +{* Delphi 6.0 *} +{$IFDEF VER140} + {$UNDEF DELPHI7} + {$UNDEF DELPHI8} + {$UNDEF DELPHI2005} + {$UNDEF DELPHI2006} + {$UNDEF DELPHI2007} + {$UNDEF DELPHI2009} + {$UNDEF DELPHI2010} + {$UNDEF DELPHI_XE} +{$ENDIF} + +{* Delphi 7.0 *} +{$IFDEF VER150} +// RTLVersion = 15.00; + {$UNDEF DELPHI8} + {$UNDEF DELPHI2005} + {$UNDEF DELPHI2006} + {$UNDEF DELPHI2007} + {$UNDEF DELPHI2009} + {$UNDEF DELPHI2010} + {$UNDEF DELPHI_XE} +{$ENDIF} + +{* Delphi 8.0 for .net *} +{$IFDEF VER160} + {$UNDEF DELPHI2005} + {$UNDEF DELPHI2006} + {$UNDEF DELPHI2007} + {$UNDEF DELPHI2009} + {$UNDEF DELPHI2010} + {$UNDEF DELPHI_XE} +{$ENDIF} + +{* Delphi 2005 / 9.0 for .net & Win32 *} +{$IFDEF VER170} + {$UNDEF DELPHI2006} + {$UNDEF DELPHI2007} + {$UNDEF DELPHI2009} + {$UNDEF DELPHI2010} + {$UNDEF DELPHI_XE} +{$ENDIF} + +{$IFDEF VER180} // Delphi 2006 / Turbo Delphi / Delphi 2007 +// RTLVersion = 18.00; + {$IFDEF VER185} // Delphi 2007 only + {* Delphi 2007 for Win32 *} + {$UNDEF DELPHI2009} + {$UNDEF DELPHI2010} + {$UNDEF DELPHI_XE} + {$ELSE} + {* Delphi 2006 / 10.0 for .net & Win32 *} + {$UNDEF DELPHI2007} + {$UNDEF DELPHI2009} + {$UNDEF DELPHI2010} + {$UNDEF DELPHI_XE} + {$ENDIF} +{$ENDIF} + +{* Delphi 2009 for Win32 *} +{$IFDEF VER200} +// RTLVersion = 20.00; + {$UNDEF DELPHI2010} + {$UNDEF DELPHI_XE} + + {$STRINGCHECKS OFF} +{$ENDIF} + +{* Delphi 2010 for Win32 *} +{$IFDEF VER210} +// RTLVersion = 21.00; + {$UNDEF DELPHI_XE} + + // http://docwiki.embarcadero.com/RADStudio/en/WEAKLINKRTTI_directive_%28Delphi%29 + {$WEAKLINKRTTI ON} + // http://docwiki.embarcadero.com/RADStudio/en/RTTI_directive_%28Delphi%29 + // {$RTTI EXPLICIT METHODS([]) PROPERTIES([]) FIELDS([])} + + // {$HIGHCHARUNICODE ON} + // http://docwiki.embarcadero.com/RADStudio/en/HIGHCHARUNICODE_directive_%28Delphi%29 + // When HIGHCHARUNICODE is ON: #$xx 2-digit and #$xxxx 4-digit literals are parsed as WideChar. +{$ENDIF} + +{* Delphi XE for Win32 *} +{$IFDEF VER220} +// RTLVersion = 22.00; +// COMPILERVERSION = 22.0 +{$ENDIF} + +{$IFDEF DELPHI7} + {$IFDEF CLR} + {$WARN UNSAFE_CODE ON} + {$WARN UNSAFE_TYPE ON} + {$WARN UNSAFE_CAST ON} + {$ELSE} + {$WARN UNSAFE_CODE OFF} + {$WARN UNSAFE_TYPE OFF} + {$WARN UNSAFE_CAST OFF} + {$ENDIF} +{$ENDIF} + +{$A+,B-,I-,P-,T+,V-,X+} + +{$IFNDEF FPC} + {$E+,F-,G+,K+,N-} +{$ENDIF} + +{$IFDEF DEBUG} + {$IFNDEF FPC} + {$L+,Y+} + {$ENDIF FPC} + + {$D+,C+,R+,S+,Q+,W+} +{$ELSE} + {$IFDEF DEBUGINFO} + {$IFNDEF FPC} + {$L+,Y+} + {$ENDIF FPC} + + {$D+,W+} + {$ELSE} + {$IFNDEF FPC} + {$L-} + {$ENDIF FPC} + + {$D-,W-} + {$ENDIF} + + {$IFNDEF FPC} + {$C-,Y-} + {$ENDIF} + + {$R-,S-,Q-} +{$ENDIF} + +{$IFDEF DELPHI2} + {$J+} + + {$IFDEF DEBUG} + {$OPTIMIZATION OFF} + {$ELSE} + {$IFDEF NO_OPT} + {$OPTIMIZATION OFF} + {$ELSE} + {$OPTIMIZATION ON} + {$ENDIF} + {$ENDIF} + + {$LONGSTRINGS ON} + {$HINTS ON} + {$WARNINGS ON} + {$J+} +{$ENDIF} + +{$IFNDEF FPC} + {$C Moveable Demandload Discardable} { Code Segment attributes } +{$ENDIF FPC} + Added: jwapi/trunk/Examples/VHD/Demo.dpr =================================================================== --- jwapi/trunk/Examples/VHD/Demo.dpr (rev 0) +++ jwapi/trunk/Examples/VHD/Demo.dpr 2011-11-13 10:33:33 UTC (rev 1109) @@ -0,0 +1,38 @@ +{******************************************************************************} +{ JEDI Virtual Disk API example } +{ http://jedi-apilib.sourceforge.net } +{ http://wiki.delphi-jedi.org/ } +{ http://blog.delphi-jedi.net/ } +{ } +{ Obtained through: Joint Endeavour of Delphi Innovators (Project JEDI) } +{ } +{ Author(s): } +{ Creation date: November 4th 2010 } +{ Last modification date: November 28th 2010 } +{ } +{ Description: Demonstrates how to use the virtual disk API } +{ with Windows 7 } +{ } +{ Preparations: JWA must be ready to use. } +{ } +{ Version history: November 4th 2010: initial version } +{ } +{ No license. Use this example with no warranty at all and on your own risk. } +{ This example is just for learning purposes and should not be used in } +{ production environments. } +{******************************************************************************} +program Demo; + +uses + Forms, + frmMain in 'frmMain.pas' {MainForm}, + checkwin7 in 'checkwin7.pas'; + +{$R *.res} + +begin + Application.Initialize; + Application.MainFormOnTaskbar := True; + Application.CreateForm(TMainForm, MainForm); + Application.Run; +end. Added: jwapi/trunk/Examples/VHD/checkwin7.pas =================================================================== --- jwapi/trunk/Examples/VHD/checkwin7.pas (rev 0) +++ jwapi/trunk/Examples/VHD/checkwin7.pas 2011-11-13 10:33:33 UTC (rev 1109) @@ -0,0 +1,32 @@ +unit checkwin7; + +interface + +uses Windows; + +implementation + +function Win7OrHigher: Boolean; +var + OSVI: TOSVersionInfo; +begin + Result:= False; + ZeroMemory(@OSVI, SizeOf(TOSVersionInfo)); + OSVI.dwOSVersionInfoSize:= SizeOf(TOSVersionInfo); + if GetVersionEx(OSVI) then + begin + if OSVI.dwMajorVersion = 6 then + Result:= (OSVI.dwMinorVersion > 0) + else + Result:= (OSVI.dwMajorVersion > 6); + end; +end; + +initialization + if not Win7OrHigher then + begin + MessageBox(0, 'Windows 7 or higher is required for VHD API.'#13#10'Program is terminated.', 'Windows Version Conflict!', MB_ICONERROR); + Halt; + end; + +end. Added: jwapi/trunk/Examples/VHD/frmMain.dfm =================================================================== --- jwapi/trunk/Examples/VHD/frmMain.dfm (rev 0) +++ jwapi/trunk/Examples/VHD/frmMain.dfm 2011-11-13 10:33:33 UTC (rev 1109) @@ -0,0 +1,56 @@ +object MainForm: TMainForm + Left = 0 + Top = 0 + BorderStyle = bsToolWindow + Caption = ' VHD API Demo' + ClientHeight = 238 + ClientWidth = 722 + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + OldCreateOrder = False + PixelsPerInch = 96 + TextHeight = 13 + object btnMount: TButton + Left = 615 + Top = 58 + Width = 89 + Height = 25 + Caption = 'Mount Image' + TabOrder = 0 + OnClick = btnMountClick + end + object btnDismount: TButton + Left = 615 + Top = 89 + Width = 89 + Height = 25 + Caption = 'Dismount' + TabOrder = 1 + OnClick = btnDismountClick + end + object MemoInfo: TMemo + Left = 8 + Top = 8 + Width = 601 + Height = 223 + TabOrder = 2 + end + object btnInfo: TButton + Left = 615 + Top = 8 + Width = 89 + Height = 25 + Caption = 'Disk Infos' + TabOrder = 3 + OnClick = btnInfoClick + end + object OpenDialogVHD: TOpenDialog + Filter = 'Virtual Hard Disk|*.vhd|All Files|*.*' + Left = 40 + Top = 24 + end +end Added: jwapi/trunk/Examples/VHD/frmMain.pas =================================================================== --- jwapi/trunk/Examples/VHD/frmMain.pas (rev 0) +++ jwapi/trunk/Examples/VHD/frmMain.pas 2011-11-13 10:33:33 UTC (rev 1109) @@ -0,0 +1,366 @@ +{******************************************************************************} +{ JEDI Virtual Disk API example } +{ http://jedi-apilib.sourceforge.net } +{ http://wiki.delphi-jedi.org/ } +{ http://blog.delphi-jedi.net/ } +{ } +{ Obtained through: Joint Endeavour of Delphi Innovators (Project JEDI) } +{ } +{ Author(s): } +{ Creation date: November 4th 2010 } +{ Last modification date: November 28th 2010 } +{ } +{ Description: Demonstrates how to use the virtual disk API } +{ with Windows 7 } +{ } +{ Preparations: JWA must be ready to use. } +{ } +{ Version history: November 4th 2010: initial version } +{ } +{ No license. Use this example with no warranty at all and on your own risk. } +{ This example is just for learning purposes and should not be used in } +{ production environments. } +{******************************************************************************} +unit frmMain; + +interface + +uses + SysUtils, Controls, Classes, Dialogs, Forms, JwaVirtDisk, JwaWinIoctl, + JwaWinNT, JwaWinBase, JwaWinType, JwaWinError, StdCtrls; + +type + TMainForm = class(TForm) + btnMount: TButton; + OpenDialogVHD: TOpenDialog; + btnDismount: TButton; + MemoInfo: TMemo; + btnInfo: TButton; + procedure btnMountClick(Sender: TObject); + procedure btnDismountClick(Sender: TObject); + procedure btnInfoClick(Sender: TObject); + private + { Private-Deklarationen } + public + { Public-Deklarationen } + end; + +var + MainForm: TMainForm; + +implementation + +{$R *.dfm} +{$R userlevel.res} // Admin rights are required for moun and dismount actions + +// more information http://msdn.microsoft.com/en-us/library/dd323700%28v=VS.85%29.aspx + +// verify the disksize to be a multiple of CREATE_VIRTUAL_DISK_PARAMETERS_DEFAULT_SECTOR_SIZE (512) +function ValidateDiskSize(VirtualDiskSize: ULONGLONG): ULONGLONG; +begin + Result:= (VirtualDiskSize div CREATE_VIRTUAL_DISK_PARAMETERS_DEFAULT_SECTOR_SIZE) * + ... [truncated message content] |