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

Last change on this file since 505 was 32, checked in by alloc, 18 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.