Added more debug logging to the service.

Author: tmcdos

.gitignore

@@ -4,3 +4,4 @@
 *.bkm
 *.drc
 *.zip
+dcu

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.

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;

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,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;
@@ -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);

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.
- 

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

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

RamService.dpr

@@ -10,6 +10,7 @@ uses
 
 begin
   Application.Initialize;
+  Application.Title := 'RamDisk service';
   Application.CreateForm(TArsenalRamDisk, ArsenalRamDisk);
   Application.Run;
 end.