Skip to content

Commit

Permalink
Now using EventLog instead of OutputDebugString for logging.
Browse files Browse the repository at this point in the history
  • Loading branch information
tmcdos committed Jul 28, 2024
1 parent 12fdb72 commit a4de57e
Show file tree
Hide file tree
Showing 8 changed files with 119 additions and 99 deletions.
18 changes: 16 additions & 2 deletions Definitions.pas
Original file line number Diff line number Diff line change
Expand Up @@ -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';
Expand Down Expand Up @@ -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;

Expand Down Expand Up @@ -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.
15 changes: 13 additions & 2 deletions Main.pas
Original file line number Diff line number Diff line change
Expand Up @@ -120,6 +120,8 @@ procedure TfrmUI.btnSaveClick(Sender: TObject);
end;

procedure TfrmUI.btnUnmountClick(Sender: TObject);
var
msg:String;
begin
try
ramDiskConfig.persistentFolder:=editFolder.Text;
Expand All @@ -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;
Expand Down Expand Up @@ -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;
Expand All @@ -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;
Expand Down
68 changes: 34 additions & 34 deletions RamCreate.pas
Original file line number Diff line number Diff line change
Expand Up @@ -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;
Expand Down Expand Up @@ -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;
Expand All @@ -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);
Expand All @@ -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));
Expand All @@ -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);
Expand All @@ -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;

Expand All @@ -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);

Expand All @@ -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
Expand All @@ -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
Expand All @@ -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;
Expand All @@ -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;

Expand All @@ -325,26 +325,26 @@ 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;

CloseHandle(volHandle);
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;
Expand All @@ -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;

Expand All @@ -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;
Expand All @@ -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 := '';
Expand All @@ -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);
Expand Down
Loading

0 comments on commit a4de57e

Please sign in to comment.