diff --git a/.gitignore b/.gitignore index 513f23e..3ca8125 100644 --- a/.gitignore +++ b/.gitignore @@ -4,3 +4,4 @@ *.bkm *.drc *.zip +dcu \ No newline at end of file diff --git a/Definitions.pas b/Definitions.pas index a19a511..d22a686 100644 --- a/Definitions.pas +++ b/Definitions.pas @@ -250,6 +250,7 @@ DRIVE_LAYOUT_INFORMATION = record Function ImDiskOpenDeviceByName(FileName:PUnicodeString; AccessMode:DWORD):THandle; Function ImScsiOpenScsiAdapter(var PortNumber:Byte):THandle; Function ImScsiDeviceIoControl(device:THandle; ControlCode: DWORD; var SrbIoControl: TSrbIoControl; Size, Timeout: DWORD; var ReturnLength: DWORD):Boolean; + Function decodeException(code:TRamErrors):String; implementation @@ -451,4 +452,18 @@ function GetFreeDriveList: TAssignedDrives; Result:=['C'..'Z'] - used; // exclude floppy drives end; +Function decodeException(code:TRamErrors):String; +Begin + Result:=''; + Case code Of + RamNotInstalled: Result:='Arsenal Driver is not installed'; + RamNotAccessible: Result:='Arsenal Driver is not accessible'; + RamCantEnumDrives: Result:='Can not enumerate disk volumes'; + RamDriverVersion: Result:='Arsenal Driver is old version'; + RamCantCreate: Result:='Could not create RAM-disk'; + RamCantFormat: Result:='Could not create a partition on the RAM-disk'; + RamNoFreeLetter: Result:='No free drive letters available'; + end; +End; + end. diff --git a/Main.pas b/Main.pas index 84eccfe..f80c2f7 100644 --- a/Main.pas +++ b/Main.pas @@ -66,24 +66,9 @@ implementation Var ramDiskConfig: TRamDisk; -Procedure decodeException(code:TRamErrors); -Var - msg: String; -Begin - msg:=''; - Case code Of - RamNotInstalled: msg:='Arsenal Driver is not installed'; - RamNotAccessible: msg:='Arsenal Driver is not accessible'; - RamCantEnumDrives: msg:='Can not enumerate disk volumes'; - RamDriverVersion: msg:='Arsenal Driver is old version'; - RamCantCreate: msg:='Could not create RAM-disk'; - RamCantFormat: msg:='Could not create a partition on the RAM-disk'; - RamNoFreeLetter: msg:='No free drive letters available'; - end; - if msg<>'' then MessageDlg(msg,mtError,[mbOK],0); -End; - procedure TfrmUI.btnApplyClick(Sender: TObject); +var + msg:String; begin SaveSettings; If not TryStrToInt64(vdSize.Text,ramDiskConfig.size) Then MessageDlg('Invalid disk size',mtError,[mbOK],0) @@ -104,7 +89,11 @@ procedure TfrmUI.btnApplyClick(Sender: TObject); UpdateMounted; end; except - On E:ERamDiskError do decodeException(E.ArsenalCode); + On E:ERamDiskError do + Begin + msg:=decodeException(E.ArsenalCode); + If msg<>'' then MessageDlg(msg,mtError,[mbOK],0); + end; else raise; End; end; diff --git a/RamCreate.pas b/RamCreate.pas index 9828698..c0e1c55 100644 --- a/RamCreate.pas +++ b/RamCreate.pas @@ -104,10 +104,23 @@ procedure HideInfo; dw: DWORD; Begin Result:=False; + OutputDebugString('Trying to query the version of Arsenal driver'); ImScsiInitializeSrbIoBlock(check.SrbIoControl, sizeof(check), SMP_IMSCSI_QUERY_VERSION, 0); - if Not DeviceIoControl(Device, IOCTL_SCSI_MINIPORT, @check, sizeof(check), @check, sizeof(check), dw, NIL) then Exit; - if dw < sizeof(check) then Exit; - if check.SrbIoControl.ReturnCode < IMSCSI_DRIVER_VERSION Then Exit; + if Not DeviceIoControl(Device, IOCTL_SCSI_MINIPORT, @check, sizeof(check), @check, sizeof(check), dw, NIL) then + Begin + OutputDebugString('Arsenal driver does not support version checking'); + Exit; + end; + if dw < sizeof(check) then + Begin + OutputDebugString(PAnsiChar(Format('Arsenal driver reports the size of data structure for version check as %u which is less than expected %u',[dw,SizeOf(check)]))); + Exit; + end; + if check.SrbIoControl.ReturnCode < IMSCSI_DRIVER_VERSION Then + Begin + OutputDebugString(PAnsiChar(Format('Arsenal driver reports version %u which is less than required %u',[check.SrbIoControl.ReturnCode,IMSCSI_DRIVER_VERSION]))); + Exit; + end; Result:=True; end; @@ -164,10 +177,16 @@ function FormatCallback (Command: TCallBackCommand; SubAction: DWORD; ActionInfo mustFormat, formatDone, mount_point_found:Boolean; Begin Result:=False; + OutputDebugString('Trying to create a new RAM-disk'); driver := ImScsiOpenScsiAdapter(portNumber); - if driver = INVALID_HANDLE_VALUE then Exit; + if driver = INVALID_HANDLE_VALUE then + Begin + OutputDebugString('Arsenal driver is not running'); + Exit; + end; if not ImScsiCheckDriverVersion(driver) then begin + OutputDebugString('Arsenal driver version is not suitable'); CloseHandle(driver); Raise ERamDiskError.Create(RamDriverVersion); end; @@ -176,7 +195,7 @@ function FormatCallback (Command: TCallBackCommand; SubAction: DWORD; ActionInfo if not ImScsiDeviceIoControl(driver, SMP_IMSCSI_CREATE_DEVICE, create_data.SrbIoControl, SizeOf(create_data), 0, dw) then begin NtClose(driver); - OutputDebugString(PAnsiChar(SysErrorMessage(GetLastError))); + OutputDebugString(PAnsiChar(Format('Could not create the RAM-disk, error is "%s"',[SysErrorMessage(GetLastError)]))); raise ERamDiskError.Create(RamCantCreate); end; NtClose(driver); @@ -188,6 +207,7 @@ function FormatCallback (Command: TCallBackCommand; SubAction: DWORD; ActionInfo while true do begin + OutputDebugString('Disk not attached yet, waiting 200 msec'); disk := ImScsiOpenDiskByDeviceNumber(create_data.Fields.DeviceNumber, portNumber, diskNumber); if disk <> INVALID_HANDLE_VALUE then Break; //printf("Disk not attached yet, waiting... %c\r", NextWaitChar(&wait_char)); @@ -200,6 +220,7 @@ function FormatCallback (Command: TCallBackCommand; SubAction: DWORD; ActionInfo begin while WaitForSingleObject(event, 200) = WAIT_TIMEOUT do begin + OutputDebugString('Rescanning SCSI adapters, disk not attached yet. Waiting 200 msec'); // printf("Disk not attached yet, waiting... %c\r", NextWaitChar(&wait_char)); end; CloseHandle(event); @@ -244,6 +265,7 @@ function FormatCallback (Command: TCallBackCommand; SubAction: DWORD; ActionInfo end; if mustFormat then begin + OutputDebugString('Will now create a partition on the RAM device'); rand_seed := GetTickCount(); while true do begin @@ -260,7 +282,11 @@ function FormatCallback (Command: TCallBackCommand; SubAction: DWORD; ActionInfo drive_layout.PartitionEntry[0].RecognizedPartition := TRUE; drive_layout.PartitionEntry[0].RewritePartition := TRUE; - if DeviceIoControl(disk, IOCTL_DISK_SET_DRIVE_LAYOUT, @drive_layout, sizeof(drive_layout), NIL, 0, dw, NIL) then Break; + if DeviceIoControl(disk, IOCTL_DISK_SET_DRIVE_LAYOUT, @drive_layout, sizeof(drive_layout), NIL, 0, dw, NIL) then + Begin + OutputDebugString('Successfully created the partition'); + Break; + end; if GetLastError <> ERROR_WRITE_PROTECT then begin CloseHandle(disk); @@ -268,6 +294,7 @@ function FormatCallback (Command: TCallBackCommand; SubAction: DWORD; ActionInfo end; //printf("Disk not yet ready, waiting... %c\r", NextWaitChar(&wait_char)); + OutputDebugString('Disk is not yet ready for partitioning, waiting ...'); ZeroMemory(@disk_attributes, sizeof(disk_attributes)); disk_attributes.AttributesMask := DISK_ATTRIBUTE_OFFLINE or DISK_ATTRIBUTE_READ_ONLY; @@ -285,6 +312,7 @@ function FormatCallback (Command: TCallBackCommand; SubAction: DWORD; ActionInfo numVolumes:=0; while true do begin + OutputDebugString('Trying to find the volume (partition) by name'); volume := FindFirstVolume(volumeName, Length(volumeName)); if volume = INVALID_HANDLE_VALUE then begin @@ -297,11 +325,13 @@ function FormatCallback (Command: TCallBackCommand; SubAction: DWORD; ActionInfo try repeat volumeName[48] := #0; + OutputDebugString(PAnsiChar(Format('Quering volume %s',[volumeName]))); volHandle := CreateFile(volumeName, 0, FILE_SHARE_READ or FILE_SHARE_WRITE, NIL, OPEN_EXISTING, 0, 0); if volHandle = INVALID_HANDLE_VALUE then Continue; if not ImScsiVolumeUsesDisk(volHandle, diskNumber) then begin CloseHandle(volHandle); + OutputDebugString('This volume is not used (created) by Arsenal'); continue; end; @@ -328,13 +358,14 @@ function FormatCallback (Command: TCallBackCommand; SubAction: DWORD; ActionInfo // we use the undocumented FMIFS.DLL instead of Format.COM or VDS or WMI or ShFormatDrive - it always takes at least 5 seconds formatDriveName:=volumeName; FormatEx(PWideChar(formatDriveName),FMIFS_HARDDISK,'NTFS','RAMDISK',True,4096,@FormatCallBack); + OutputDebugString('Successfully created NTFS filesystem on the RAM-disk'); if ShowProgress then HideInfo; end; volumeName[48] := '\'; if Not GetVolumePathNamesForVolumeName(volumeName, mountName, Length(mountName), dw) then begin - OutputDebugString('Error enumerating mount points'); + OutputDebugString(PAnsiChar(Format('Error enumerating mount points for volume %s',[volumeName]))); continue; end; @@ -344,9 +375,11 @@ function FormatCallback (Command: TCallBackCommand; SubAction: DWORD; ActionInfo mountList.Text:=mountName; for i:=0 to mountList.Count-1 do begin + OutputDebugString(PAnsiChar(Format('Now trying to get a drive letter for "%s"',[mountList[i]]))); if mountList[i] = '' then Break; if CompareText(mountPoint,mountList[i])<>0 then begin + OutputDebugString('Removing the old mount point'); if Not DeleteVolumeMountPoint(PAnsiChar(mountList[i])) then begin dw:=GetLastError; @@ -356,6 +389,7 @@ function FormatCallback (Command: TCallBackCommand; SubAction: DWORD; ActionInfo else begin mount_point_found := true; + OutputDebugString(PAnsiChar(Format('Mounted at %s',[mountPoint]))); // ImScsiOemPrintF(stdout, " Mounted at %1!ws!", mnt); end; end; @@ -366,6 +400,7 @@ function FormatCallback (Command: TCallBackCommand; SubAction: DWORD; ActionInfo MountPoint[1] := ImDiskFindFreeDriveLetter(); if MountPoint[1] = #0 then raise ERamDiskError.Create(RamNoFreeLetter) Else config.letter:=MountPoint[1]; + OutputDebugString(PAnsiChar('Will use drive letter ' + MountPoint[1])); end; if not SetVolumeMountPoint(PAnsiChar(MountPoint), volumeName) then begin @@ -389,6 +424,7 @@ function FormatCallback (Command: TCallBackCommand; SubAction: DWORD; ActionInfo end; //printf("Volume not yet attached, waiting... %c\r", NextWaitChar(&wait_char)); + OutputDebugString('Volume not yet attached, waiting 200 msec'); Sleep(200); end; LoadRamDisk(config); diff --git a/RamRemove.pas b/RamRemove.pas index 264a01f..e142589 100644 --- a/RamRemove.pas +++ b/RamRemove.pas @@ -88,9 +88,12 @@ function AutoEjectVolume(AVolumeHandle: THandle): boolean; forceDismount: Boolean; Begin Result:=False; + OutputDebugString('Begin DetachRamDisk'); If existing.letter = #0 Then Begin + OutputDebugString('RamDisk has no drive letter attahed'); adapter := ImScsiOpenScsiAdapter(portNumber); + OutputDebugString(PAnsiChar(Format('SCSI adapter handle = %u',[adapter]))); if adapter = INVALID_HANDLE_VALUE then begin dw:=GetLastError; @@ -113,15 +116,19 @@ function AutoEjectVolume(AVolumeHandle: THandle): boolean; Exit; end; end; + OutputDebugString('RamDisk device has been destroyed'); Result:=True; Exit; end; if existing.synchronize And (existing.persistentFolder<>'') then SaveRamDisk(existing); forceDismount:=False; + OutputDebugString(PAnsiChar(Format('Trying to open volume %s',[existing.letter]))); device := OpenVolume(existing.letter); if device = INVALID_HANDLE_VALUE then begin - case GetLastError of + tmp:=GetLastError; + OutputDebugString(PAnsiChar(Format('Could not open the volume, error is "%s"',[SysErrorMessage(tmp)]))); + case tmp of ERROR_INVALID_PARAMETER: // "This version of Windows only supports drive letters as mount points.\n" // "Windows 2000 or higher is required to support subdirectory mount points.\n", @@ -135,28 +142,44 @@ function AutoEjectVolume(AVolumeHandle: THandle): boolean; // ImScsiOemPrintF(stderr, "Not a mount point: '%1!ws!'", MountPoint); Exit; else - tmp:=GetLastError; raise Exception.Create(SysErrorMessage(tmp)); end; End; // Notify processes that this device is about to be removed. + OutputDebugString('Now notifying other processes that this device is about to be removed'); ImDiskNotifyRemovePending(WideChar(existing.letter)); + OutputDebugString('Flushing OS file buffers'); FlushFileBuffers(device); // Locking volume try - if Not DeviceIoControl(device, FSCTL_LOCK_VOLUME, NIL, 0, NIL, 0, dw, NIL) then forceDismount := TRUE; + OutputDebugString('Locking the volume'); + if Not DeviceIoControl(device, FSCTL_LOCK_VOLUME, NIL, 0, NIL, 0, dw, NIL) then + Begin + forceDismount := TRUE; + OutputDebugString('Could not lock the volume - so trying a forced unmount'); + End; // Unmounting filesystem try + OutputDebugString('Trying to unmount the filesystem'); if DeviceIoControl(device, FSCTL_DISMOUNT_VOLUME, NIL, 0, NIL, 0, dw, NIL) then begin - if forceDismount then DeviceIoControl(device, FSCTL_LOCK_VOLUME, NIL, 0, NIL, 0, dw, NIL); + if forceDismount then + Begin + DeviceIoControl(device, FSCTL_LOCK_VOLUME, NIL, 0, NIL, 0, dw, NIL); + OutputDebugString('Doing forced lock'); + end; // Set prevent removal to false and eject the volume - if PreventRemovalOfVolume(device, FALSE) then AutoEjectVolume(device); + if PreventRemovalOfVolume(device, FALSE) then + Begin + AutoEjectVolume(device); + OutputDebugString('Ejected the volume'); + End; Result:=True; end; finally DeviceIoControl(device, FSCTL_UNLOCK_VOLUME, NIL, 0, NIL, 0, dw, NIL); + OutputDebugString('Unlocked the volume'); End; finally CloseHandle(device); @@ -165,4 +188,3 @@ function AutoEjectVolume(AVolumeHandle: THandle): boolean; end; end. - \ No newline at end of file diff --git a/RamService.cfg b/RamService.cfg index 224f349..f641c43 100644 --- a/RamService.cfg +++ b/RamService.cfg @@ -31,6 +31,7 @@ -M -$M16384,1048576 -K$00400000 +-E"bin" -LE"c:\program files (x86)\borland\delphi7\..\Bpl" -LN"c:\program files (x86)\borland\delphi7\..\Bpl" -w-UNSAFE_TYPE diff --git a/RamService.dof b/RamService.dof index 8550fed..5706f40 100644 --- a/RamService.dof +++ b/RamService.dof @@ -90,7 +90,7 @@ MaxStackSize=1048576 ImageBase=4194304 ExeDescription= [Directories] -OutputDir= +OutputDir=bin UnitOutputDir= PackageDLLOutputDir= PackageDCPOutputDir= @@ -135,8 +135,15 @@ ProductName= ProductVersion=1.0.0.0 Comments= [Excluded Packages] -C:\Program Files (x86)\Borland\Delphi7\Bin\indy70.bpl=Internet Direct (Indy) for D7 +c:\Program Files (x86)\Borland\Bpl\prgInternet6.bpl=Progsan Internet Components c:\Program Files (x86)\Borland\Bpl\kctrls6.bpl=KStringGrid component +[HistoryLists\hlUnitAliases] +Count=1 +Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; +[HistoryLists\hlOutputDirectorry] +Count=2 +Item0=bin +Item1=DCU [Exception Log] EurekaLog Version=6105 Activate=0 diff --git a/RamService.dpr b/RamService.dpr index ff14668..b65a57f 100644 --- a/RamService.dpr +++ b/RamService.dpr @@ -10,6 +10,7 @@ uses begin Application.Initialize; + Application.Title := 'RamDisk service'; Application.CreateForm(TArsenalRamDisk, ArsenalRamDisk); Application.Run; end. diff --git a/RamService.res b/RamService.res index 2fddc33..80b045b 100644 Binary files a/RamService.res and b/RamService.res differ diff --git a/RamSync.pas b/RamSync.pas index d44103a..1537485 100644 --- a/RamSync.pas +++ b/RamSync.pas @@ -102,10 +102,16 @@ procedure DelTree(const path:String); reg: TTntRegistry; tempDir:String; Begin - If (config.persistentFolder<>'') And DirectoryExists(config.persistentFolder) Then TreeCopy(WideIncludeTrailingPathDelimiter(config.persistentFolder),config.letter+':\'); + OutputDebugString('Configuring RAM-disk'); + If (config.persistentFolder<>'') And DirectoryExists(config.persistentFolder) Then + Begin + TreeCopy(WideIncludeTrailingPathDelimiter(config.persistentFolder),config.letter+':\'); + OutputDebugStringW(PWideChar('RAM-disk was populated with content from ' + config.persistentFolder)); + end; If config.useTemp Then Begin tempDir:=config.letter+':\TEMP'; + OutputDebugString(PAnsiChar('Configuring TEMP folder as ' + tempDir)); if CreateDir(tempDir) Then Begin reg:=Nil; @@ -116,6 +122,7 @@ procedure DelTree(const path:String); Begin reg.WriteExpandString('TMP',tempDir); reg.WriteExpandString('TEMP',tempDir); + OutputDebugString('TMP and TEMP folders for all users were set'); end; reg.CloseKey; @@ -124,6 +131,7 @@ procedure DelTree(const path:String); Begin reg.WriteExpandString('TMP',tempDir); reg.WriteExpandString('TEMP',tempDir); + OutputDebugString('TMP and TEMP folders for the current user were set'); end; reg.CloseKey; finally @@ -143,13 +151,16 @@ procedure RestoreTempFolder(letter:WideChar); Begin reg:=Nil; try + OutputDebugString('Switching to the default TEMP folder'); reg:=TTntRegistry.Create(KEY_ALL_ACCESS); // read defaults reg.RootKey:=HKEY_USERS; if Reg.OpenKey('.DEFAULT\Environment', False) then Begin tmpFolder:=reg.ReadString('TMP'); + OutputDebugString(PAnsiChar(Format('Default TMP folder = %s',[tmpFolder]))); tempFolder:=reg.ReadString('TEMP'); + OutputDebugString(PAnsiChar(Format('Default TEMP folder = %s',[tempFolder]))); end; reg.CloseKey; // set active values @@ -158,9 +169,17 @@ procedure RestoreTempFolder(letter:WideChar); Begin // restore default only if current setting was using the just unmounted Ramdisk tmp:=WideUpperCase(reg.ReadString('TMP')); - If (tmp<>'')And(tmp[1] = letter) then reg.WriteExpandString('TMP',tmpFolder); + If (tmp<>'')And(tmp[1] = letter) then + Begin + reg.WriteExpandString('TMP',tmpFolder); + OutputDebugString('Restoring TMP folder for all users'); + End; tmp:=WideUpperCase(reg.ReadString('TEMP')); - If (tmp<>'')and(tmp[1] = letter) then reg.WriteExpandString('TEMP',tempFolder); + If (tmp<>'')and(tmp[1] = letter) then + Begin + reg.WriteExpandString('TEMP',tempFolder); + OutputDebugString('Restoring TEMP folder for all users'); + End; end; reg.CloseKey; @@ -168,9 +187,17 @@ procedure RestoreTempFolder(letter:WideChar); if Reg.OpenKey('Environment', True) then Begin tmp:=WideUpperCase(reg.ReadString('TMP')); - If (tmp<>'')and(tmp[1] = letter) then reg.WriteExpandString('TMP',tmpFolder); + If (tmp<>'')and(tmp[1] = letter) then + Begin + reg.WriteExpandString('TMP',tmpFolder); + OutputDebugString('Restoring TMP folder for the current user'); + end; tmp:=WideUpperCase(reg.ReadString('TEMP')); - If (tmp<>'')and(tmp[1] = letter) then reg.WriteExpandString('TEMP',tempFolder); + If (tmp<>'')and(tmp[1] = letter) then + Begin + reg.WriteExpandString('TEMP',tempFolder); + OutputDebugString('Restoring TMP folder for the current user'); + end; end; reg.CloseKey; finally @@ -209,6 +236,7 @@ procedure TreeSave(const src,dest:WideString;excluded:TTntStringList); SR: TSearchRecW; junction,current,source: WideString; Begin + OutputDebugStringW(PWideChar(WideFormat('Now persisting folder %s',[src]))); if WideFindFirst(src+'*.*',faAnyFile,SR)<>0 then Exit; repeat if (SR.Name <> '.') and (SR.Name <> '..') then @@ -246,6 +274,7 @@ procedure TreeDelete(const src,dest:WideString;excluded:TTntStringList); var SR: TSearchRecW; Begin + OutputDebugStringW(PWideChar(WideFormat('Now removing folder %s',[src]))); if WideFindFirst(src+'*.*',faAnyFile,SR)<>0 then Exit; repeat if (SR.Name <> '.') and (SR.Name <> '..') then @@ -290,7 +319,8 @@ procedure TreeDelete(const src,dest:WideString;excluded:TTntStringList); var list:TTntStringList; Begin - if DirectoryExists(existing.persistentFolder) then + OutputDebugString('Trying to persist RamDisk before unmount'); + if WideDirectoryExists(existing.persistentFolder) then Begin list:=Nil; try @@ -301,12 +331,18 @@ procedure TreeDelete(const src,dest:WideString;excluded:TTntStringList); list.Add('System Volume Information'); // first we persist RAM-disk, excluding disabled paths TreeSave(existing.letter+':\',WideIncludeTrailingPathDelimiter(existing.persistentFolder),list); + OutputDebugString('RamDisk content was persisted'); // then we delete the data that is not present on the RAM-disk - if existing.deleteOld then TreeDelete(WideIncludeTrailingPathDelimiter(existing.persistentFolder),existing.letter+':\',list); + if existing.deleteOld then + Begin + TreeDelete(WideIncludeTrailingPathDelimiter(existing.persistentFolder),existing.letter+':\',list); + OutputDebugString('Obsolete data inside the synchronization folder was removed'); + End; Finally list.Free; end; - end; + End + else OutputDebugStringW(PWideChar(WideFormat('Folder "%s" does not exist',[existing.persistentFolder]))); end; end. diff --git a/SrvMain.pas b/SrvMain.pas index 9474395..69390f8 100644 --- a/SrvMain.pas +++ b/SrvMain.pas @@ -37,38 +37,47 @@ procedure LoadSettings; Begin reg:=TTntRegistry.Create(KEY_READ); Try + OutputDebugString('Reading settings from registry'); reg.RootKey:=HKEY_LOCAL_MACHINE; if Reg.OpenKey('SYSTEM\CurrentControlSet\Services\ArsenalRamDisk', False) then begin If Reg.ValueExists('DiskSize') then Begin config.size:=StrToInt64(reg.ReadString('DiskSize')); + OutputDebugString(PAnsiChar(Format('Reading DiskSize = %u',[config.size]))); end; if reg.ValueExists('DriveLetter') Then Begin config.letter:=Char(reg.ReadString('DriveLetter')[1]); + OutputDebugString(PAnsiChar(Format('Reading DriveLetter = %s',[config.letter]))); end; if reg.ValueExists('LoadContent') Then Begin config.persistentFolder:=reg.ReadString('LoadContent'); + OutputDebugStringW(PWideChar(WideFormat('Reading LoadContent = %s',[config.persistentFolder]))); end; if reg.ValueExists('ExcludeFolders') Then Begin config.excludedList:=reg.ReadString('ExcludeFolders'); + OutputDebugStringW(PWideChar(WideFormat('Reading ExcludeFolders = %s',[config.excludedList]))); end; if reg.ValueExists('UseTempFolder') Then Begin config.useTemp:=reg.ReadBool('UseTempFolder'); + OutputDebugString(PAnsiChar(Format('Reading UseTempFolder = %d',[Ord(config.useTemp)]))); end; if reg.ValueExists('SyncContent') Then Begin config.synchronize:=reg.ReadBool('SyncContent'); + OutputDebugString(PAnsiChar(Format('Reading SyncContent = %d',[Ord(config.synchronize)]))); end; if reg.ValueExists('DeleteOld') Then Begin config.deleteOld:=reg.ReadBool('DeleteOld'); + OutputDebugString(PAnsiChar(Format('Reading DeleteOld = %d',[Ord(config.deleteOld)]))); end; Reg.CloseKey; + OutputDebugString('All settings from registry were loaded'); end; Finally reg.Free; @@ -110,20 +119,43 @@ procedure TArsenalRamDisk.ServiceExecute(Sender: TService); procedure TArsenalRamDisk.ServiceShutdown(Sender: TService); begin + OutputDebugString('RamDisk service initiated shutdown'); DetachRamDisk(config); end; procedure TArsenalRamDisk.ServiceStart(Sender: TService; var Started: Boolean); begin + OutputDebugString('RamDisk service was started'); LoadSettings; if (config.size<>0) then + try if CreateRamDisk(config,False) Then Started:=True; + except + On E:ERamDiskError do decodeException(E.ArsenalCode); + On E:Exception do OutputDebugString(PAnsiChar(E.Message)); + End; end; procedure TArsenalRamDisk.ServiceStop(Sender: TService; var Stopped: Boolean); +var + msg:string; begin + OutputDebugString('RamDisk service is being stopped'); if config.letter <> #0 then - If DetachRamDisk(config) then Stopped:=True; + begin + OutputDebugString('Trying to unmount RamDisk'); + try + If DetachRamDisk(config) then Stopped:=True; + except + On E:ERamDiskError do + Begin + msg:=decodeException(E.ArsenalCode); + If msg<>'' then OutputDebugString(PAnsiChar(msg)); + end; + On E:Exception Do OutputDebugString(PAnsiChar(E.Message)); + end; + End + Else Stopped:=True; end; end.