From a4de57e26406e0d38401b3e025e29c4e038da6a2 Mon Sep 17 00:00:00 2001 From: tmcdos Date: Sun, 28 Jul 2024 14:41:46 +0300 Subject: [PATCH] Now using EventLog instead of OutputDebugString for logging. --- Definitions.pas | 18 +++++++++++-- Main.pas | 15 +++++++++-- RamCreate.pas | 68 ++++++++++++++++++++++++------------------------- RamRemove.pas | 36 +++++++++++++------------- RamService.dpr | 1 + RamSetup.pas | 4 +-- RamSync.pas | 36 +++++++++++++------------- SrvMain.pas | 40 +++++++++++++---------------- 8 files changed, 119 insertions(+), 99 deletions(-) diff --git a/Definitions.pas b/Definitions.pas index d22a686..04b7949 100644 --- a/Definitions.pas +++ b/Definitions.pas @@ -251,11 +251,15 @@ DRIVE_LAYOUT_INFORMATION = record 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; + Procedure DebugLog(msg:string;eventType:DWord = EVENTLOG_INFORMATION_TYPE); implementation Uses Math,Classes; +Var + EventLogHandle:Integer; + procedure RtlInitUnicodeString(DestinationString: PUnicodeString; SourceString: LPWSTR); stdcall; external 'ntdll.dll'; function RtlNtStatusToDosError(Status: NTSTATUS): ULONG; stdcall; external 'ntdll.dll'; function NtClose(_Handle: THandle): NTSTATUS; stdcall; external 'ntdll.dll'; @@ -336,11 +340,11 @@ procedure InitializeObjectAttributes(var InitializedAttributes: TObjectAttribute ImScsiInitializeSrbIoBlock(SrbIoControl, Size, ControlCode, Timeout); if Not DeviceIoControl(Device, IOCTL_SCSI_MINIPORT, @SrbIoControl, Size, @SrbIoControl, Size, ReturnLength, NIL) then begin - OutputDebugString(PAnsiChar(SysErrorMessage(RtlNtStatusToDosError(SrbIoControl.ReturnCode)))); + DebugLog(SysErrorMessage(RtlNtStatusToDosError(SrbIoControl.ReturnCode)),EVENTLOG_ERROR_TYPE); Result:=FALSE; Exit; end; - OutputDebugString(PAnsiChar(SysErrorMessage(RtlNtStatusToDosError(SrbIoControl.ReturnCode)))); + DebugLog(SysErrorMessage(RtlNtStatusToDosError(SrbIoControl.ReturnCode))); Result:=SrbIoControl.ReturnCode >= 0; end; @@ -466,4 +470,14 @@ function GetFreeDriveList: TAssignedDrives; end; End; +Procedure DebugLog(msg:string;eventType:DWord = EVENTLOG_INFORMATION_TYPE); +Begin + ReportEvent(EventLogHandle,eventType,0,0,Nil,1,0,PChar(msg),Nil); +end; + +Initialization + EventLogHandle:=RegisterEventSource(Nil,'Arsenal RamDisk'); + +Finalization + DeregisterEventSource(EventLogHandle); end. diff --git a/Main.pas b/Main.pas index f80c2f7..3a6ab50 100644 --- a/Main.pas +++ b/Main.pas @@ -120,6 +120,8 @@ procedure TfrmUI.btnSaveClick(Sender: TObject); end; procedure TfrmUI.btnUnmountClick(Sender: TObject); +var + msg:String; begin try ramDiskConfig.persistentFolder:=editFolder.Text; @@ -131,7 +133,11 @@ procedure TfrmUI.btnUnmountClick(Sender: TObject); UpdateDismounted; 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; @@ -323,6 +329,7 @@ procedure TfrmUI.btnUninstallClick(Sender: TObject); procedure TfrmUI.FormShow(Sender: TObject); Var srvStatus:DWORD; + msg:String; begin // aim -a -s 50M -t vm -m x: UpdateLetters; @@ -336,7 +343,11 @@ procedure TfrmUI.FormShow(Sender: TObject); if GetRamDisk(ramDiskConfig) Then UpdateMounted Else UpdateDismounted; 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 c0e1c55..5b6894e 100644 --- a/RamCreate.pas +++ b/RamCreate.pas @@ -104,21 +104,21 @@ procedure HideInfo; dw: DWORD; Begin Result:=False; - OutputDebugString('Trying to query the version of Arsenal driver'); + DebugLog('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 Begin - OutputDebugString('Arsenal driver does not support version checking'); + DebugLog('Arsenal driver does not support version checking',EVENTLOG_ERROR_TYPE); 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)]))); + DebugLog(Format('Arsenal driver reports the size of data structure for version check as %u which is less than expected %u',[dw,SizeOf(check)]),EVENTLOG_ERROR_TYPE); 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]))); + DebugLog(Format('Arsenal driver reports version %u which is less than required %u',[check.SrbIoControl.ReturnCode,IMSCSI_DRIVER_VERSION]),EVENTLOG_ERROR_TYPE); Exit; end; Result:=True; @@ -177,16 +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'); + DebugLog('Trying to create a new RAM-disk'); driver := ImScsiOpenScsiAdapter(portNumber); if driver = INVALID_HANDLE_VALUE then Begin - OutputDebugString('Arsenal driver is not running'); + DebugLog('Arsenal driver is not running',EVENTLOG_ERROR_TYPE); Exit; end; if not ImScsiCheckDriverVersion(driver) then begin - OutputDebugString('Arsenal driver version is not suitable'); + DebugLog('Arsenal driver version is not suitable',EVENTLOG_ERROR_TYPE); CloseHandle(driver); Raise ERamDiskError.Create(RamDriverVersion); end; @@ -195,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(Format('Could not create the RAM-disk, error is "%s"',[SysErrorMessage(GetLastError)]))); + DebugLog(Format('Could not create the RAM-disk, error is "%s"',[SysErrorMessage(GetLastError)]),EVENTLOG_ERROR_TYPE); raise ERamDiskError.Create(RamCantCreate); end; NtClose(driver); @@ -207,7 +207,7 @@ function FormatCallback (Command: TCallBackCommand; SubAction: DWORD; ActionInfo while true do begin - OutputDebugString('Disk not attached yet, waiting 200 msec'); + DebugLog('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)); @@ -220,7 +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'); + DebugLog('Rescanning SCSI adapters, disk not attached yet. Waiting 200 msec'); // printf("Disk not attached yet, waiting... %c\r", NextWaitChar(&wait_char)); end; CloseHandle(event); @@ -234,7 +234,7 @@ function FormatCallback (Command: TCallBackCommand; SubAction: DWORD; ActionInfo if disk = INVALID_HANDLE_VALUE then begin dw:=GetLastError; - OutputDebugString(PAnsiChar('Error reopening for writing ' + devPath + ': ' + SysErrorMessage(dw))); + DebugLog('Error reopening for writing ' + devPath + ': ' + SysErrorMessage(dw),EVENTLOG_ERROR_TYPE); raise ERamDiskError.Create(RamNotAccessible); end; @@ -243,7 +243,7 @@ function FormatCallback (Command: TCallBackCommand; SubAction: DWORD; ActionInfo if not DeviceIoControl(disk, IOCTL_DISK_SET_DISK_ATTRIBUTES, @disk_attributes, sizeof(disk_attributes), NIL, 0, dw, NIL) And (GetLastError <> ERROR_INVALID_FUNCTION) then begin - OutputDebugString('Cannot set disk in writable online mode'); + DebugLog('Cannot set disk in writable online mode',EVENTLOG_ERROR_TYPE); end; DeviceIoControl(disk, FSCTL_ALLOW_EXTENDED_DASD_IO, NIL, 0, NIL, 0, dw, NIL); @@ -253,19 +253,19 @@ function FormatCallback (Command: TCallBackCommand; SubAction: DWORD; ActionInfo begin if disk_size <> config.size then begin - OutputDebugString(PAnsiChar('Disk ' + devPath + ' has unexpected size: ' + IntToStr(disk_size))); + DebugLog('Disk ' + devPath + ' has unexpected size: ' + IntToStr(disk_size),EVENTLOG_ERROR_TYPE); mustFormat := False; end; end else if GetLastError <> ERROR_INVALID_FUNCTION then begin dw:=GetLastError; - OutputDebugString(PAnsiChar('Can not query size of disk ' + devPath + ': ' + SysErrorMessage(dw))); + DebugLog('Can not query size of disk ' + devPath + ': ' + SysErrorMessage(dw),EVENTLOG_ERROR_TYPE); mustFormat := False; end; if mustFormat then begin - OutputDebugString('Will now create a partition on the RAM device'); + DebugLog('Will now create a partition on the RAM device'); rand_seed := GetTickCount(); while true do begin @@ -284,7 +284,7 @@ function FormatCallback (Command: TCallBackCommand; SubAction: DWORD; ActionInfo if DeviceIoControl(disk, IOCTL_DISK_SET_DRIVE_LAYOUT, @drive_layout, sizeof(drive_layout), NIL, 0, dw, NIL) then Begin - OutputDebugString('Successfully created the partition'); + DebugLog('Successfully created the partition'); Break; end; if GetLastError <> ERROR_WRITE_PROTECT then @@ -294,7 +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 ...'); + DebugLog('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; @@ -305,18 +305,18 @@ function FormatCallback (Command: TCallBackCommand; SubAction: DWORD; ActionInfo end; if not DeviceIoControl(disk, IOCTL_DISK_UPDATE_PROPERTIES, NIL, 0, NIL, 0, dw, NIL) - And (GetLastError <> ERROR_INVALID_FUNCTION) then OutputDebugString('Error updating disk properties'); + And (GetLastError <> ERROR_INVALID_FUNCTION) then DebugLog('Error updating disk properties',EVENTLOG_ERROR_TYPE); CloseHandle(disk); start_time := GetTickCount(); formatDone := false; numVolumes:=0; while true do begin - OutputDebugString('Trying to find the volume (partition) by name'); + DebugLog('Trying to find the volume (partition) by name'); volume := FindFirstVolume(volumeName, Length(volumeName)); if volume = INVALID_HANDLE_VALUE then begin - OutputDebugString('Error enumerating disk volumes'); + DebugLog('Error enumerating disk volumes',EVENTLOG_ERROR_TYPE); raise ERamDiskError.Create(RamCantEnumDrives); End; @@ -325,13 +325,13 @@ function FormatCallback (Command: TCallBackCommand; SubAction: DWORD; ActionInfo try repeat volumeName[48] := #0; - OutputDebugString(PAnsiChar(Format('Quering volume %s',[volumeName]))); + DebugLog(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'); + DebugLog('This volume is not used (created) by Arsenal'); continue; end; @@ -339,12 +339,12 @@ function FormatCallback (Command: TCallBackCommand; SubAction: DWORD; ActionInfo Inc(numVolumes); volHandle := CreateFile(volumeName, GENERIC_READ or GENERIC_WRITE, FILE_SHARE_READ or FILE_SHARE_WRITE, NIL, OPEN_EXISTING, 0, 0); - if volHandle = INVALID_HANDLE_VALUE then OutputDebugString('Error opening volume in read/write mode') + if volHandle = INVALID_HANDLE_VALUE then DebugLog('Error opening volume in read/write mode',EVENTLOG_ERROR_TYPE) else begin if Not DeviceIoControl(volHandle, IOCTL_VOLUME_ONLINE, NIL, 0, NIL, 0, dw, NIL) then begin - OutputDebugString('Error setting volume in online mode'); + DebugLog('Error setting volume in online mode',EVENTLOG_ERROR_TYPE); end; CloseHandle(volHandle); end; @@ -358,14 +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'); + DebugLog('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(PAnsiChar(Format('Error enumerating mount points for volume %s',[volumeName]))); + DebugLog(Format('Error enumerating mount points for volume %s',[volumeName]),EVENTLOG_ERROR_TYPE); continue; end; @@ -375,21 +375,21 @@ 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]]))); + DebugLog(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'); + DebugLog('Removing the old mount point'); if Not DeleteVolumeMountPoint(PAnsiChar(mountList[i])) then begin dw:=GetLastError; - OutputDebugString(PAnsiChar('Error removing old mount point "'+mountList[i]+'": ' + SysErrorMessage(dw))); + DebugLog('Error removing old mount point "'+mountList[i]+'": ' + SysErrorMessage(dw),EVENTLOG_ERROR_TYPE); end; end else begin mount_point_found := true; - OutputDebugString(PAnsiChar(Format('Mounted at %s',[mountPoint]))); + DebugLog(Format('Mounted at %s',[mountPoint])); // ImScsiOemPrintF(stdout, " Mounted at %1!ws!", mnt); end; end; @@ -400,12 +400,12 @@ 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])); + DebugLog('Will use drive letter ' + MountPoint[1]); end; if not SetVolumeMountPoint(PAnsiChar(MountPoint), volumeName) then begin dw:=GetLastError; - OutputDebugString(PAnsiChar('Error setting volume ' + volumeName + ' mount point to ' + MountPoint + ' : ' + SysErrorMessage(dw))); + DebugLog('Error setting volume ' + volumeName + ' mount point to ' + MountPoint + ' : ' + SysErrorMessage(dw),EVENTLOG_ERROR_TYPE); end else Break; //MountPoint := ''; @@ -419,12 +419,12 @@ function FormatCallback (Command: TCallBackCommand; SubAction: DWORD; ActionInfo if formatDone or (numVolumes > 0) then break; if not mustFormat and ((GetTickCount() - start_time) > 3000) then begin - OutputDebugString('No volumes attached. Disk could be offline or not partitioned.'); + DebugLog('No volumes attached. Disk could be offline or not partitioned.',EVENTLOG_ERROR_TYPE); break; end; //printf("Volume not yet attached, waiting... %c\r", NextWaitChar(&wait_char)); - OutputDebugString('Volume not yet attached, waiting 200 msec'); + DebugLog('Volume not yet attached, waiting 200 msec'); Sleep(200); end; LoadRamDisk(config); diff --git a/RamRemove.pas b/RamRemove.pas index e142589..145b4e8 100644 --- a/RamRemove.pas +++ b/RamRemove.pas @@ -88,17 +88,17 @@ function AutoEjectVolume(AVolumeHandle: THandle): boolean; forceDismount: Boolean; Begin Result:=False; - OutputDebugString('Begin DetachRamDisk'); + DebugLog('Begin DetachRamDisk'); If existing.letter = #0 Then Begin - OutputDebugString('RamDisk has no drive letter attahed'); + DebugLog('RamDisk has no drive letter attahed'); adapter := ImScsiOpenScsiAdapter(portNumber); - OutputDebugString(PAnsiChar(Format('SCSI adapter handle = %u',[adapter]))); + DebugLog(Format('SCSI adapter handle = %u',[adapter])); if adapter = INVALID_HANDLE_VALUE then begin dw:=GetLastError; - if dw = ERROR_FILE_NOT_FOUND then OutputDebugString('Arsenal Driver not installed') - else OutputDebugString(PAnsiChar(SysErrorMessage(dw))); + if dw = ERROR_FILE_NOT_FOUND then DebugLog('Arsenal Driver not installed',EVENTLOG_ERROR_TYPE) + else DebugLog(SysErrorMessage(dw),EVENTLOG_ERROR_TYPE); raise ERamDiskError.Create(RamNotInstalled); end; deviceNumber.LongNumber:=IMSCSI_ALL_DEVICES; @@ -107,27 +107,27 @@ function AutoEjectVolume(AVolumeHandle: THandle): boolean; dw:=GetLastError; if dw = ERROR_FILE_NOT_FOUND then begin - OutputDebugString('No devices found'); + DebugLog('The SCSI device of the RAM-disk was not found',EVENTLOG_ERROR_TYPE); Exit; end else begin - OutputDebugString(PAnsiChar(SysErrorMessage(dw))); + DebugLog(SysErrorMessage(dw),EVENTLOG_ERROR_TYPE); Exit; end; end; - OutputDebugString('RamDisk device has been destroyed'); + DebugLog('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]))); + DebugLog(Format('Trying to open volume %s',[existing.letter])); device := OpenVolume(existing.letter); if device = INVALID_HANDLE_VALUE then begin tmp:=GetLastError; - OutputDebugString(PAnsiChar(Format('Could not open the volume, error is "%s"',[SysErrorMessage(tmp)]))); + DebugLog(Format('Could not open the volume, error is "%s"',[SysErrorMessage(tmp)]),EVENTLOG_ERROR_TYPE); case tmp of ERROR_INVALID_PARAMETER: // "This version of Windows only supports drive letters as mount points.\n" @@ -146,40 +146,40 @@ function AutoEjectVolume(AVolumeHandle: THandle): boolean; 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'); + DebugLog('Now notifying other processes that this device is about to be removed'); ImDiskNotifyRemovePending(WideChar(existing.letter)); - OutputDebugString('Flushing OS file buffers'); + DebugLog('Flushing OS file buffers'); FlushFileBuffers(device); // Locking volume try - OutputDebugString('Locking the volume'); + DebugLog('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'); + DebugLog('Could not lock the volume - so trying a forced unmount'); End; // Unmounting filesystem try - OutputDebugString('Trying to unmount the filesystem'); + DebugLog('Trying to unmount the filesystem'); if DeviceIoControl(device, FSCTL_DISMOUNT_VOLUME, NIL, 0, NIL, 0, dw, NIL) then begin if forceDismount then Begin DeviceIoControl(device, FSCTL_LOCK_VOLUME, NIL, 0, NIL, 0, dw, NIL); - OutputDebugString('Doing forced lock'); + DebugLog('Doing forced lock'); end; // Set prevent removal to false and eject the volume if PreventRemovalOfVolume(device, FALSE) then Begin AutoEjectVolume(device); - OutputDebugString('Ejected the volume'); + DebugLog('Ejected the volume'); End; Result:=True; end; finally DeviceIoControl(device, FSCTL_UNLOCK_VOLUME, NIL, 0, NIL, 0, dw, NIL); - OutputDebugString('Unlocked the volume'); + DebugLog('Unlocked the volume'); End; finally CloseHandle(device); diff --git a/RamService.dpr b/RamService.dpr index b65a57f..2f8a46b 100644 --- a/RamService.dpr +++ b/RamService.dpr @@ -1,6 +1,7 @@ program RamService; {$R 'manifest.res' 'manifest.rc'} +{$DEFINE RAMDISK_SVC} uses SvcMgr, diff --git a/RamSetup.pas b/RamSetup.pas index 43bc857..8134244 100644 --- a/RamSetup.pas +++ b/RamSetup.pas @@ -6,7 +6,7 @@ interface implementation -uses Windows,SysUtils,Classes; +uses Windows,SysUtils,Classes,Definitions; const CfgMgrDllName = 'cfgmgr32.dll'; @@ -36,7 +36,7 @@ function CM_Get_Device_ID_List_Size(var ulLen: ULONG; const pszFilter: PAnsiChar status := CM_Locate_DevNode(dev_inst, rootid, 0); if status <> CR_SUCCESS then begin - OutputDebugString(PAnsiChar('Error scanning for hardware changes: $' + IntToHex(status,8))); + DebugLog('Error scanning for hardware changes: $' + IntToHex(status,8),EVENTLOG_ERROR_TYPE); Result:=status; end else Result:=CM_Reenumerate_DevNode(dev_inst, flags); diff --git a/RamSync.pas b/RamSync.pas index 1537485..c996d93 100644 --- a/RamSync.pas +++ b/RamSync.pas @@ -102,16 +102,16 @@ procedure DelTree(const path:String); reg: TTntRegistry; tempDir:String; Begin - OutputDebugString('Configuring RAM-disk'); + DebugLog('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)); + DebugLog('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)); + DebugLog('Configuring TEMP folder as ' + tempDir); if CreateDir(tempDir) Then Begin reg:=Nil; @@ -122,7 +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'); + DebugLog('TMP and TEMP folders for all users were set'); end; reg.CloseKey; @@ -131,7 +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'); + DebugLog('TMP and TEMP folders for the current user were set'); end; reg.CloseKey; finally @@ -151,16 +151,16 @@ procedure RestoreTempFolder(letter:WideChar); Begin reg:=Nil; try - OutputDebugString('Switching to the default TEMP folder'); + DebugLog('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]))); + DebugLog(Format('Default TMP folder = %s',[tmpFolder])); tempFolder:=reg.ReadString('TEMP'); - OutputDebugString(PAnsiChar(Format('Default TEMP folder = %s',[tempFolder]))); + DebugLog(Format('Default TEMP folder = %s',[tempFolder])); end; reg.CloseKey; // set active values @@ -172,13 +172,13 @@ procedure RestoreTempFolder(letter:WideChar); If (tmp<>'')And(tmp[1] = letter) then Begin reg.WriteExpandString('TMP',tmpFolder); - OutputDebugString('Restoring TMP folder for all users'); + DebugLog('Restoring TMP folder for all users'); End; tmp:=WideUpperCase(reg.ReadString('TEMP')); If (tmp<>'')and(tmp[1] = letter) then Begin reg.WriteExpandString('TEMP',tempFolder); - OutputDebugString('Restoring TEMP folder for all users'); + DebugLog('Restoring TEMP folder for all users'); End; end; reg.CloseKey; @@ -190,13 +190,13 @@ procedure RestoreTempFolder(letter:WideChar); If (tmp<>'')and(tmp[1] = letter) then Begin reg.WriteExpandString('TMP',tmpFolder); - OutputDebugString('Restoring TMP folder for the current user'); + DebugLog('Restoring TMP folder for the current user'); end; tmp:=WideUpperCase(reg.ReadString('TEMP')); If (tmp<>'')and(tmp[1] = letter) then Begin reg.WriteExpandString('TEMP',tempFolder); - OutputDebugString('Restoring TMP folder for the current user'); + DebugLog('Restoring TMP folder for the current user'); end; end; reg.CloseKey; @@ -236,7 +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]))); + DebugLog(WideFormat('Now persisting folder %s',[src])); if WideFindFirst(src+'*.*',faAnyFile,SR)<>0 then Exit; repeat if (SR.Name <> '.') and (SR.Name <> '..') then @@ -274,7 +274,7 @@ procedure TreeDelete(const src,dest:WideString;excluded:TTntStringList); var SR: TSearchRecW; Begin - OutputDebugStringW(PWideChar(WideFormat('Now removing folder %s',[src]))); + DebugLog(WideFormat('Now removing folder %s',[src])); if WideFindFirst(src+'*.*',faAnyFile,SR)<>0 then Exit; repeat if (SR.Name <> '.') and (SR.Name <> '..') then @@ -319,7 +319,7 @@ procedure TreeDelete(const src,dest:WideString;excluded:TTntStringList); var list:TTntStringList; Begin - OutputDebugString('Trying to persist RamDisk before unmount'); + DebugLog('Trying to persist RamDisk before unmount'); if WideDirectoryExists(existing.persistentFolder) then Begin list:=Nil; @@ -331,18 +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'); + DebugLog('RamDisk content was persisted'); // then we delete the data that is not present on the RAM-disk if existing.deleteOld then Begin TreeDelete(WideIncludeTrailingPathDelimiter(existing.persistentFolder),existing.letter+':\',list); - OutputDebugString('Obsolete data inside the synchronization folder was removed'); + DebugLog('Obsolete data inside the synchronization folder was removed'); End; Finally list.Free; end; End - else OutputDebugStringW(PWideChar(WideFormat('Folder "%s" does not exist',[existing.persistentFolder]))); + else DebugLog(WideFormat('Folder "%s" does not exist',[existing.persistentFolder]),EVENTLOG_ERROR_TYPE); end; end. diff --git a/SrvMain.pas b/SrvMain.pas index 69390f8..37f7ed9 100644 --- a/SrvMain.pas +++ b/SrvMain.pas @@ -37,47 +37,47 @@ procedure LoadSettings; Begin reg:=TTntRegistry.Create(KEY_READ); Try - OutputDebugString('Reading settings from registry'); + DebugLog('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]))); + DebugLog(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]))); + DebugLog(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]))); + DebugLog(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]))); + DebugLog(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)]))); + DebugLog(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)]))); + DebugLog(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)]))); + DebugLog(Format('Reading DeleteOld = %d',[Ord(config.deleteOld)])); end; Reg.CloseKey; - OutputDebugString('All settings from registry were loaded'); + DebugLog('All settings from registry were loaded'); end; Finally reg.Free; @@ -119,40 +119,34 @@ procedure TArsenalRamDisk.ServiceExecute(Sender: TService); procedure TArsenalRamDisk.ServiceShutdown(Sender: TService); begin - OutputDebugString('RamDisk service initiated shutdown'); + DebugLog('RamDisk service initiated shutdown'); DetachRamDisk(config); end; procedure TArsenalRamDisk.ServiceStart(Sender: TService; var Started: Boolean); begin - OutputDebugString('RamDisk service was started'); + DebugLog('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)); + On E:ERamDiskError do DebugLog(decodeException(E.ArsenalCode)); + On E:Exception do DebugLog(E.Message); End; end; procedure TArsenalRamDisk.ServiceStop(Sender: TService; var Stopped: Boolean); -var - msg:string; begin - OutputDebugString('RamDisk service is being stopped'); + DebugLog('RamDisk service is being stopped'); if config.letter <> #0 then begin - OutputDebugString('Trying to unmount RamDisk'); + DebugLog('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)); + On E:ERamDiskError do DebugLog(decodeException(E.ArsenalCode)); + On E:Exception Do DebugLog(E.Message); end; End Else Stopped:=True;