Skip to content

Commit 0d6b64a

Browse files
tmcdostmcdos
committed
Moved WidePosEx to Definitions.pas, added background threads for creating/destroying RAM-disk in RamService and periodically notifying SCM that the service is not hung. This should handle cases where copying a lot of data from/to RAM-disk on boot/shutdown can take more than the default 30 seconds. Hopefully will fix issue #10 
1 parent 2f0579d commit 0d6b64a

8 files changed

Lines changed: 219 additions & 85 deletions

File tree

‎.gitignore‎

Lines changed: 97 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,101 @@
1+
# Modern Delphi 12.3 .gitignore
2+
#
3+
#-------------------------------------------------------------------------------
4+
# Delphi / C++Builder Compiled Output & Binaries
5+
#-------------------------------------------------------------------------------
16
*.exe
27
*.dll
8+
*.so
9+
*.a
10+
*.lib
11+
*.bpl
12+
*.dcp
313
*.dcu
4-
*.bkm
14+
*.obj
15+
*.o
16+
17+
# Compiled resource files
18+
*.res
19+
20+
#-------------------------------------------------------------------------------
21+
# IDE Generated, User-Specific & Intermediate Files
22+
#-------------------------------------------------------------------------------
23+
*.~*
24+
*.bak
25+
*.old
26+
27+
# Delphi 7 and Delphi 6 Diagram Portfolio
28+
*.ddp
29+
30+
# Delphi 7 (and older) Project Configuration filed automatically created by command line compiler
31+
*.cfg
32+
33+
# General temporary files
34+
*.tmp
35+
36+
# General temporary files
37+
*.temp
38+
39+
*.local
40+
*.dsk
41+
*.cfg
42+
*.map
43+
*.tds
544
*.drc
6-
*.zip
7-
dcu
45+
*.rsm
46+
*.log
47+
*.pch
48+
*.ipch
49+
*.stat
50+
*.identcache
51+
*.dproj.local
52+
*.dproj.user
53+
*.groupproj.local
54+
*.groupproj.user
55+
56+
# Delphi IDE bookmarks
57+
*.bkm
58+
59+
# TestInsight configuration files
60+
*.tvsconfig
61+
62+
# Files with .history extension
63+
*.history
64+
65+
# Legacy project files
66+
*.dof
67+
*.kof
68+
69+
#-------------------------------------------------------------------------------
70+
# IDE History, Recovery & Autosave
71+
#-------------------------------------------------------------------------------
72+
**/__history/
73+
**/__recovery/
74+
*.autosave
75+
76+
#-------------------------------------------------------------------------------
77+
# Output Directories (using **/ to match at any depth)
78+
#-------------------------------------------------------------------------------
79+
**/Win32/
80+
**/Win64/
81+
**/Debug/
82+
**/Release/
83+
84+
# Cross-platform output folders
85+
**/Linux64/
86+
**/OSX64/
87+
**/OSXARM64/
88+
**/Android/
89+
**/Android64/
90+
**/iOSDevice32/
91+
**/iOSDevice64/
92+
**/iOSSimulator/
93+
94+
#-------------------------------------------------------------------------------
95+
# Common Temporary / Local / Sensitive Files (General)
96+
#-------------------------------------------------------------------------------
97+
# General compressed archives (often backups or downloads)
98+
*.zip
99+
100+
# Environment variable files (CRITICAL for sensitive data)
101+
*.env

‎Definitions.pas‎

Lines changed: 39 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -250,12 +250,13 @@ DRIVE_LAYOUT_INFORMATION = record
250250
Function ImDiskOpenDeviceByName(FileName:PUnicodeString; AccessMode:DWORD):THandle;
251251
Function ImScsiOpenScsiAdapter(var PortNumber:Byte):THandle;
252252
Function ImScsiDeviceIoControl(device:THandle; ControlCode: DWORD; var SrbIoControl: TSrbIoControl; Size, Timeout: DWORD; var ReturnLength: DWORD):Boolean;
253+
Function WidePosEx(const SubStr, S: widestring; Offset: Integer = 1): Integer;
253254
Function decodeException(code:TRamErrors):String;
254255
Procedure DebugLog(msg:string;eventType:DWord = EVENTLOG_INFORMATION_TYPE);
255256

256257
implementation
257258

258-
Uses Math,Classes;
259+
Uses Math,Classes, TntWideStrUtils;
259260

260261
Var
261262
EventLogHandle:Integer;
@@ -462,6 +463,43 @@ function GetFreeDriveList: TAssignedDrives;
462463
Result:=['C'..'Z'] - used; // exclude floppy drives
463464
end;
464465

466+
procedure WStrDelete(var S: WideString; Index, Count: Integer);
467+
var
468+
L, N: Integer;
469+
NewStr: PWideChar;
470+
begin
471+
L := Length(S);
472+
if (L > 0) and (Index >= 1) and (Index <= L) and (Count > 0) then
473+
begin
474+
Dec(Index);
475+
N := L - Index - Count;
476+
if N < 0 then N := 0;
477+
if (Index = 0) and (N = 0) then NewStr := nil else
478+
begin
479+
NewStr := WStrAlloc(Index + N);
480+
if Index > 0 then
481+
Move(Pointer(S)^, NewStr^, Index * 2);
482+
if N > 0 then
483+
Move(PWideChar(Pointer(S))[L - N], NewStr[Index], N * 2);
484+
end;
485+
S := WStrPas(NewStr);
486+
WStrDispose(NewStr);
487+
end;
488+
end;
489+
490+
function WidePosEx(const SubStr, S: widestring; Offset: Integer = 1): Integer;
491+
var
492+
i: integer;
493+
tmp: widestring;
494+
begin
495+
Result := 0;
496+
tmp := S;
497+
WStrDelete(tmp,1,Offset);
498+
i := Pos(SubStr, tmp);
499+
if (i > 0) then
500+
Result := Offset + i;
501+
end;
502+
465503
Function decodeException(code:TRamErrors):String;
466504
Begin
467505
Result:='';

‎Main.pas‎

Lines changed: 1 addition & 38 deletions
Original file line numberDiff line numberDiff line change
@@ -67,43 +67,6 @@ implementation
6767
Var
6868
ramDiskConfig: TRamDisk;
6969

70-
procedure WStrDelete(var S: WideString; Index, Count: Integer);
71-
var
72-
L, N: Integer;
73-
NewStr: PWideChar;
74-
begin
75-
L := Length(S);
76-
if (L > 0) and (Index >= 1) and (Index <= L) and (Count > 0) then
77-
begin
78-
Dec(Index);
79-
N := L - Index - Count;
80-
if N < 0 then N := 0;
81-
if (Index = 0) and (N = 0) then NewStr := nil else
82-
begin
83-
NewStr := WStrAlloc(Index + N);
84-
if Index > 0 then
85-
Move(Pointer(S)^, NewStr^, Index * 2);
86-
if N > 0 then
87-
Move(PWideChar(Pointer(S))[L - N], NewStr[Index], N * 2);
88-
end;
89-
S := WStrPas(NewStr);
90-
WStrDispose(NewStr);
91-
end;
92-
end;
93-
94-
function WidePosEx(const SubStr, S: widestring; Offset: Integer = 1): Integer;
95-
var
96-
i: integer;
97-
tmp: widestring;
98-
begin
99-
Result := 0;
100-
tmp := S;
101-
WStrDelete(tmp,1,Offset);
102-
i := Pos(SubStr, tmp);
103-
if (i > 0) then
104-
Result := Offset + i;
105-
end;
106-
10770
procedure TfrmUI.btnApplyClick(Sender: TObject);
10871
var
10972
msg:String;
@@ -267,7 +230,7 @@ procedure TfrmUI.FormCreate(Sender: TObject);
267230
Begin
268231
s:=Trim(memoIgnore.Lines[i]);
269232
If (Length(s) >= 2) And (s[2]=':') then s:=Copy(s,4,MaxInt);
270-
If (s='')or(WidePosEx('\',s)>0)or(WidePosEx('/',s)>0) then memoIgnore.Lines.Delete(i)
233+
If (s = '') or (WidePosEx('\',s) > 0) or (WidePosEx('/',s) > 0) then memoIgnore.Lines.Delete(i)
271234
else
272235
Begin
273236
memoIgnore.Lines[i]:=s;

‎RamSync.pas‎

Lines changed: 1 addition & 21 deletions
Original file line numberDiff line numberDiff line change
@@ -294,27 +294,7 @@ procedure TreeDelete(const src,dest:WideString;excluded:TTntStringList);
294294
Until WideFindNext(SR) <> 0;
295295
WideFindClose(SR);
296296
end;
297-
{
298-
Procedure SplitPath(const path:WideString;var list:TStrArray);
299-
var
300-
oldPos,newPos,k:Integer;
301-
Begin
302-
SetLength(List,Length(path));
303-
k:=0;
304-
oldPos:=1;
305-
Repeat
306-
newPos:=WidePosEx('\',path,oldPos);
307-
if newPos=0 then list[k]:=Copy(path,oldPos,MaxInt)
308-
Else
309-
Begin
310-
list[k]:=Copy(path,oldPos,newPos - oldPos);
311-
oldPos:=newPos;
312-
end;
313-
Inc(k);
314-
Until newPos=0;
315-
SetLength(list,k);
316-
end;
317-
}
297+
318298
Procedure SaveRamDisk(Var existing:TRamDisk);
319299
var
320300
list:TTntStringList;

‎RamdiskUI.dof‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -115,7 +115,7 @@ AutoIncBuild=0
115115
MajorVer=1
116116
MinorVer=1
117117
Release=1
118-
Build=12
118+
Build=14
119119
Debug=0
120120
PreRelease=0
121121
Special=0
@@ -126,7 +126,7 @@ CodePage=1251
126126
[Version Info Keys]
127127
CompanyName=
128128
FileDescription=
129-
FileVersion=1.1.1.12
129+
FileVersion=1.1.1.14
130130
InternalName=
131131
LegalCopyright=
132132
LegalTrademarks=

‎RamdiskUI.res‎

0 Bytes
Binary file not shown.

‎SrvMain.dfm‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -2,7 +2,7 @@ object ArsenalRamDisk: TArsenalRamDisk
22
OldCreateOrder = False
33
AllowPause = False
44
DisplayName = 'Arsenal RAM-disk'
5-
WaitHint = 8000
5+
WaitHint = 10000
66
AfterInstall = ServiceAfterInstall
77
OnExecute = ServiceExecute
88
OnShutdown = ServiceShutdown

0 commit comments

Comments
 (0)