source: oup/releases/0.29a3/TFileTypeRegistration/SysUtils.inc @ 32

Last change on this file since 32 was 32, checked in by alloc, 16 years ago
File size: 6.8 KB
Line 
1function fileexists(const szFilename: string): boolean;
2var
3  Handle   : THandle;
4  FindData : TWin32FindData;
5begin
6  Handle := FindFirstFile(pchar(szFilename),FindData);
7  Result := (Handle <> INVALID_HANDLE_VALUE);
8
9  if(Result) then Windows.FindClose(Handle);
10end;
11
12function ExtractFileDrive(const szFilename: string): string;
13var
14  i : integer;
15begin
16  Result := '';
17  i      := length(szFilename);
18  while(i > 0) do
19  begin
20    if(szFileName[i] = ':') then
21    begin
22      Result := copy(szFilename,1,i);
23      break;
24    end;
25
26    dec(i);
27  end;
28end;
29
30function ExtractFilePath(const szFilename: string): string;
31var
32  i : integer;
33begin
34  Result := '';
35  i      := length(szFileName);
36  while(i > 0) do
37  begin
38    if(szFileName[i] = ':') or
39      (szFileName[i] = '\') then
40    begin
41      Result := copy(szFileName,1,i);
42      break;
43    end;
44
45    dec(i);
46  end;
47end;
48
49function ExtractFileName(const szFilename: string): string;
50var
51  i : integer;
52begin
53  i := length(szFilename);
54  while(i > 0) do
55  begin
56    if(szFilename[i] = '\') then
57      break;
58
59    dec(i);
60  end;
61
62  Result := copy(szFilename,i + 1,length(szFilename));
63end;
64
65function CutFileExt(const szFilename: string): string;
66var
67  i : integer;
68begin
69  i := length(szFilename);
70  while(i > 0) do
71  begin
72    if(szFilename[i] = '.') then
73      break;
74
75    dec(i);
76  end;
77
78  if(i = 0) then Result := szFilename
79    else Result := copy(szFilename,1,i-1);
80end;
81
82function ChangeFileExt(const szFileName, szNewExt: string): string;
83begin
84  Result := CutFileExt(szFileName);
85
86  if(szNewExt[1] <> '.') then Result := Result + '.' + szNewExt
87    else Result := Result + szNewExt;
88end;
89
90function FileSearch(const Name, DirList: string): string;
91var
92  I, P, L: Integer;
93begin
94  Result := Name;
95  P      := 1;
96  L      := length(DirList);
97
98  while(true) do begin
99    if(fileexists(Result)) then exit;
100
101    while(P <= L) and (DirList[P] = ';') do inc(P);
102    if(P > L) then break;
103
104    I := P;
105    while(P <= L) and (DirList[P] <> ';') do inc(P);
106
107    Result   := copy(DirList,I,P-I);
108    if not(Result[length(Result)] in[':','\']) then
109      Result := Result + '\';
110
111    Result := Result + Name;
112  end;
113
114  Result  := '';
115end;
116
117function StrToIntDef(const s: string; const i: integer): integer;
118var
119  code : integer;
120begin
121  Val(s,Result,code); if(code <> 0) then
122                        Result := i;
123end;
124
125function IntToStr(const i: integer): string;
126begin
127  Str(i,Result);
128end;
129
130// -----------------------------------------------------------------------------
131
132function Format(fmt: string; params: array of const): string;
133var
134  pdw1,
135  pdw2 : PDWORD;
136  i    : integer;
137  pc   : PCHAR;
138begin
139  pdw1 := nil;
140
141  if High(params) >= 0 then
142    GetMem(pdw1, (High(params) + 1) * sizeof(Pointer));
143
144  pdw2  := pdw1;
145  for i := 0 to High(params) do
146    begin
147      pdw2^ := PDWORD(@params[i])^;
148      inc(pdw2);
149    end;
150
151  pc := GetMemory(1024);
152  if Assigned(pc) then
153    try
154      SetString(Result, pc, wvsprintf(pc, PCHAR(fmt), PCHAR(pdw1)));
155    finally
156      if (pdw1 <> nil) then FreeMem(pdw1);
157      FreeMem(pc);
158    end
159  else
160    Result := '';
161end;
162
163
164// -----------------------------------------------------------------------------
165
166function UpperCase(const s: string): string;
167var
168  i : integer;
169begin
170  Result := '';
171
172  if(length(s) > 0) then
173    begin
174      SetLength(Result,length(s));
175      for i := 1 to length(s) do
176        Result[i] := UpCase(s[i]);
177    end;
178end;
179
180function LowerCase(const s: string): string;
181var
182  i : integer;
183begin
184  Result := '';
185
186  if(length(s) > 0) then
187    begin
188      SetLength(Result,length(s));
189      for i := 1 to length(s) do
190        case s[i] of
191          'A'..'Z','Ä','Ö','Ü':
192            Result[i] := CHR(BYTE(s[i]) + 32);
193          else
194            Result[i] := s[i];
195        end;
196    end;
197end;
198
199function LoggedUser: string;
200var
201  dwLen  : dword;
202  fTest  : boolean;
203begin
204  Result := '';
205  dwLen  := MAX_PATH; SetLength(Result,dwLen);
206
207  fTest  := GetUserName(@Result[1],dwLen);
208
209  if(not fTest) and (GetLastError = ERROR_MORE_DATA) then begin
210    SetLength(Result,dwLen);
211    fTest := GetUserName(@Result[1],dwLen);
212  end;
213
214  if(fTest) and (Result[1] <> #0) then
215    SetLength(Result,dwLen - 1);
216end;
217
218// -----------------------------------------------------------------------------
219
220//
221// delete files during next reboot (code by sakura)
222//
223function DeleteFileDuringNextSystemBoot(aFileName: string): Boolean;
224var
225  ShortName,
226  winini    : string;
227  os        : TOSVersionInfo;
228  ts        : array of string;
229  f         : TextFile;
230  i         : integer;
231begin
232  Result := False;
233
234  // get OS version
235  os.dwOSVersionInfoSize := sizeof(TOSVersionInfo);
236  GetVersionEx(os);
237
238  case os.dwPlatformId of
239    // NT systems
240    VER_PLATFORM_WIN32_NT:
241      Result := MoveFileEx(pchar(aFileName),nil,
242        MOVEFILE_REPLACE_EXISTING + MOVEFILE_DELAY_UNTIL_REBOOT);
243    // 9x systems
244    VER_PLATFORM_WIN32_WINDOWS:
245      begin
246        // get Windows folder
247        SetLength(winini,MAX_PATH+1);
248        SetLength(winini,GetWindowsDirectory(@winini[1],MAX_PATH+1));
249
250        if(winini <> '') then begin
251          if(winini[length(winini)] <> '\') then
252            winini := winini + '\';
253          winini   := winini + 'wininit.ini';
254
255          // get short name of the given file
256          SetLength(ShortName,MAX_PATH+1);
257          SetLength(ShortName,
258            GetShortPathName(@aFilename[1],@ShortName[1],MAX_PATH+1));
259
260          if(ShortName <> '') then begin
261            // add it to "wininit.ini" to delete
262            // during next reboot
263            SetLength(ts,0);
264
265            {$I-}
266            // get old file´s content
267            AssignFile(f,winini);
268            ReSet(f);
269            if(IoResult = 0) then begin
270              while(not eof(f)) do begin
271                SetLength(ts,length(ts)+1);
272                ReadLn(f,ts[length(ts)-1]);
273
274                if(lstrcmpi('[rename]',pchar(ts[length(ts)-1])) = 0) then begin
275                  SetLength(ts,length(ts)+1);
276                  ts[length(ts)-1] := 'NUL='+ShortName;
277                end;
278              end;
279              CloseFile(f);
280            end;
281
282            if(length(ts) = 0) then begin
283              SetLength(ts,2);
284              ts[0] := '[rename]';
285              ts[1] := 'NUL='+ShortName;
286            end;
287
288            // re-create
289            ReWrite(f);
290            Result := (IoResult = 0);
291            if(Result) then begin
292              for i := 0 to length(ts) - 1 do
293                WriteLn(f,ts[i]);
294
295              CloseFile(f);
296            end;
297            {$I+}
298
299            SetLength(ts,0);
300          end;
301        end;
302      end;
303    // only 9x and NT are supported
304    else
305      exit;
306  end;
307end;
Note: See TracBrowser for help on using the repository browser.