Skip to content

Commit

Permalink
Added more debug logging to the service.
Browse files Browse the repository at this point in the history
  • Loading branch information
tmcdos committed Jul 28, 2024
1 parent 2af7923 commit 12fdb72
Show file tree
Hide file tree
Showing 11 changed files with 182 additions and 42 deletions.
1 change: 1 addition & 0 deletions .gitignore
Original file line number Diff line number Diff line change
Expand Up @@ -4,3 +4,4 @@
*.bkm
*.drc
*.zip
dcu
15 changes: 15 additions & 0 deletions Definitions.pas
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand Down Expand Up @@ -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.
25 changes: 7 additions & 18 deletions Main.pas
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand All @@ -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;
Expand Down
50 changes: 43 additions & 7 deletions RamCreate.pas
Original file line number Diff line number Diff line change
Expand Up @@ -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;

Expand Down Expand Up @@ -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;
Expand All @@ -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);
Expand All @@ -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));
Expand All @@ -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);
Expand Down Expand Up @@ -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
Expand All @@ -260,14 +282,19 @@ 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);
Raise ERamDiskError.Create(RamCantFormat);
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;
Expand All @@ -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
Expand All @@ -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;

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

Expand All @@ -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;
Expand All @@ -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;
Expand All @@ -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
Expand All @@ -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);
Expand Down
34 changes: 28 additions & 6 deletions RamRemove.pas
Original file line number Diff line number Diff line change
Expand Up @@ -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;
Expand All @@ -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",
Expand All @@ -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);
Expand All @@ -165,4 +188,3 @@ function AutoEjectVolume(AVolumeHandle: THandle): boolean;
end;

end.

1 change: 1 addition & 0 deletions RamService.cfg
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
11 changes: 9 additions & 2 deletions RamService.dof
Original file line number Diff line number Diff line change
Expand Up @@ -90,7 +90,7 @@ MaxStackSize=1048576
ImageBase=4194304
ExeDescription=
[Directories]
OutputDir=
OutputDir=bin
UnitOutputDir=
PackageDLLOutputDir=
PackageDCPOutputDir=
Expand Down Expand Up @@ -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
Expand Down
1 change: 1 addition & 0 deletions RamService.dpr
Original file line number Diff line number Diff line change
Expand Up @@ -10,6 +10,7 @@ uses

begin
Application.Initialize;
Application.Title := 'RamDisk service';
Application.CreateForm(TArsenalRamDisk, ArsenalRamDisk);
Application.Run;
end.
Binary file modified RamService.res
Binary file not shown.
Loading

0 comments on commit 12fdb72

Please sign in to comment.