WebSVN – autosfx – Diff – /Functions.pas


unit Functions;
 
interface
 
uses
  Forms, Windows, Classes, SysUtils, ShellAPI,
  ZipMstr19, ZmUtils19, ShlObj, ActiveX;
 
type
  TLineBreak = (lbWindows, lbLinux, lbMac);
 
function RawFileCopy(ASrc, ADst: string): boolean;
function ShellExecuteAndWait(FileName: string; Params: string): boolean;
function FileSize(AFilename: string): int64;
function LooksLikeDir(s: string): boolean;
function GetTempDirectory: String;
function NormalizeLineBreaks(s: string; mode: TLineBreak): string;
function ExtractFileNameWithoutExt(const fil: string): string;
function SearchNextFreeName(s: string; wantDir: boolean): string;
function GetSpecialFolderPath(const Folder: integer): string;
function IsExtractable(AFilename: string): boolean;
function IsDirectoryWritable(const Dir: String): Boolean;
function IsAtFlobbyDisk(AFileOrDir: string): boolean;
 
implementation
 
{$IFNDEF UNICODE}
type
  TCharSet = set of AnsiChar;
{$ENDIF}
 
{$IFNDEF UNICODE}
function CharInSet(C: AnsiChar; const CharSet: TCharSet): Boolean;// overload;
begin
  Result := c in CharSet;
end;
{$ENDIF}
 
function LooksLikeDir(s: string): boolean;
begin
  result := CharInSet(s[Length(s)], ['/', '\']);
end;
 
function RawFileCopy(ASrc, ADst: string): boolean;
var
  SSrc, SDst: TFileStream;
begin
  DeleteFile(PChar(ADst));
 
  SSrc := TFileStream.Create(ASrc, fmOpenRead);
  try
    SDst := TFileStream.Create(ADst, fmCreate);
    try
      SDst.CopyFrom(SSrc, SSrc.Size);
    finally
      SDst.Free;
    end;
  finally
    SSrc.Free;
  end;
 
  result := true;
end;
 
// http://www.delphipraxis.net/32234-shellexecuteandwait-status-abfragen.html
// Modified. Now CONSOLE compatible and return false if ErrorLevel <> 0
function ShellExecuteAndWait(FileName: string; Params: string): boolean;
var
  exInfo: TShellExecuteInfo;
  Ph: DWORD;
  lExitCode: DWord;
begin
  Try
    FillChar(exInfo, SizeOf(exInfo), 0);
    with exInfo do
    begin
      cbSize := SizeOf(exInfo);
      fMask := SEE_MASK_NOCLOSEPROCESS or SEE_MASK_FLAG_DDEWAIT;
      Wnd := GetActiveWindow();
      FileName := ExpandUNCFileName(FileName);
      ExInfo.lpVerb := 'open';
      ExInfo.lpParameters := PChar(Params);
//      ExInfo.lpDirectory := PChar(ExtractFilePath(FileName));
      lpFile := PChar(FileName);
      nShow := SW_SHOWNORMAL;
    end;
    if ShellExecuteEx(@exInfo) then
    begin
      Ph := exInfo.HProcess;
    end
    else
    begin
      WriteLn(SysErrorMessage(GetLastError));
      Result := False;
      Exit;
    end;
    while WaitForSingleObject(ExInfo.hProcess, 50) <> WAIT_OBJECT_0 do ;
    (* begin
      Application.ProcessMessages;
    end; *)
    GetExitCodeProcess(Ph, lExitCode);
    Result := lExitCode = 0;
    CloseHandle(Ph);
  Except
    Result := False;
    Exit;
  End;
end;
 
function FileSize(AFilename: string): int64;
var
  s: TFileStream;
begin
  s := TFileStream.Create(AFilename, fmOpenRead or fmShareDenyWrite);
  try
    result := s.Size;
  finally
    s.Free;
  end;
end;
 
// http://www.cryer.co.uk/brian/delphi/howto_get_temp.htm
function GetTempDirectory: String;
var
  tempFolder: array[0..MAX_PATH] of Char;
begin
  GetTempPath(MAX_PATH, @tempFolder);
  result := StrPas(tempFolder);
end;
 
function NormalizeLineBreaks(s: string; mode: TLineBreak): string;
begin
  if mode = lbWindows then
  begin
    s := StringReplace(s, #13#10, #10, [rfReplaceAll]);
    s := StringReplace(s, #13,    #10, [rfReplaceAll]);
    s := StringReplace(s, #10, #13#10, [rfReplaceAll]);
  end
  else if mode = lbLinux then
  begin
    s := StringReplace(s, #13#10, #13, [rfReplaceAll]);
    s := StringReplace(s, #10,    #13, [rfReplaceAll]);
  end
  else if mode = lbMac then
  begin
    s := StringReplace(s, #13#10, #10, [rfReplaceAll]);
    s := StringReplace(s, #13,    #10, [rfReplaceAll]);
  end;
  result := s;
end;
 
// http://www.viathinksoft.de/?page=codelib&showid=70
function ExtractFileNameWithoutExt(const fil: string): string;
begin
  result := Copy(ExtractFileName(fil), 1, Length(ExtractFileName(fil))-Length(ExtractFileExt(fil)));
end;
 
function SearchNextFreeName(s: string; wantDir: boolean): string;
var
  i: integer;
begin
  if not FileExists(s) and not DirectoryExists(s) then
  begin
    result := s;
    if wantDir then result := IncludeTrailingPathDelimiter(result);
    Exit;
  end;
 
  i := 2;
 
  if wantDir then
  begin
    s := ExcludeTrailingPathDelimiter(s);
    repeat
      result := Format('%s (%d)', [s, i]);
      inc(i);
    until not DirectoryExists(result) and not FileExists(result);
    result := IncludeTrailingPathDelimiter(result);
  end
  else
  begin
    repeat
      result := Format('%s (%d)%s', [ExtractFilePath(s)+ExtractFileNameWithoutExt(s), i, ExtractFileExt(s)]);
      inc(i);
    until not DirectoryExists(result) and not FileExists(result);
  end;
end;
 
// GetSpecialFolderPath
// Ref: http://www.wer-weiss-was.de/theme159/article1058561.html
function GetSpecialFolderPath(const Folder: integer): string;
var
  PIDL: PItemIDList;
  Path: array[0..MAX_PATH] of char;
  Malloc: IMalloc;
begin
  Path := '';
  if Succeeded((SHGetSpecialFolderLocation(0, Folder, PIDL))) then
    if (SHGetPathFromIDList(PIDL, Path)) then
      if Succeeded(ShGetMalloc(Malloc)) then
      begin
        Malloc.Free(PIDL);
        Malloc := nil;
      end;
  Result := Path;
end;
 
function IsExtractable(AFilename: string): boolean;
var
  q: integer;
  uz: TZipMaster19;
begin
  // TODO: Ist die Funktion gut? Fraglich, ob EOC64 ein Teil von EOC ist.
  uz := TZipMaster19.Create(nil);
  try
    q := uz.QueryZip(AFilename);
    result := true;
    if (q and zqbHasLocal) <> zqbHasLocal then result := false;
    if (q and zqbHasCentral) <> zqbHasCentral then result := false;
    if ((q and zqbHasEOC) <> zqbHasEOC) and
       ((q and zqbHasEOC64) <> zqbHasEOC64) then result := false;
  finally
    uz.Free;
  end;
end;
 
// Ref: http://www.delphiarea.com/articles/how-to-find-if-a-directory-is-writable/
function IsDirectoryWritable(const Dir: String): Boolean;
var
  TempFile: array[0..MAX_PATH] of Char;
begin
  if GetTempFileName(PChar(Dir), 'DA', 0, TempFile) <> 0 then
    Result := Windows.DeleteFile(TempFile)
  else
    Result := False;
end;
 
function IsAtFlobbyDisk(AFileOrDir: string): boolean;
var
  s: string;
begin
  s := ExtractFileDrive(AFileOrDir);
  s := UpperCase(s);
 
  result := (s = 'A:') or (s = 'B:');
end;
 
end.
 

Rev 3	Rev 5
1	unit Functions;	1	unit Functions;
2		2
3	interface	3	interface
4		4
5	uses	5	uses
6	Forms, Windows, Classes, SysUtils, ShellAPI,	6	Forms, Windows, Classes, SysUtils, ShellAPI,
7	ZipMstr19, ZmUtils19, ShlObj, ActiveX;	7	ZipMstr19, ZmUtils19, ShlObj, ActiveX;
8		8
9	type	9	type
10	TLineBreak = (lbWindows, lbLinux, lbMac);	10	TLineBreak = (lbWindows, lbLinux, lbMac);
11		11
12	function RawFileCopy(ASrc, ADst: string): boolean;	12	function RawFileCopy(ASrc, ADst: string): boolean;
13	function ShellExecuteAndWait(FileName: string; Params: string): boolean;	13	function ShellExecuteAndWait(FileName: string; Params: string): boolean;
14	function FileSize(AFilename: string): int64;	14	function FileSize(AFilename: string): int64;
15	function LooksLikeDir(s: string): boolean;	15	function LooksLikeDir(s: string): boolean;
16	function GetTempDirectory: String;	16	function GetTempDirectory: String;
17	function NormalizeLineBreaks(s: string; mode: TLineBreak): string;	17	function NormalizeLineBreaks(s: string; mode: TLineBreak): string;
18	function ExtractFileNameWithoutExt(const fil: string): string;	18	function ExtractFileNameWithoutExt(const fil: string): string;
19	function SearchNextFreeName(s: string; wantDir: boolean): string;	19	function SearchNextFreeName(s: string; wantDir: boolean): string;
20	function GetSpecialFolderPath(const Folder: integer): string;	20	function GetSpecialFolderPath(const Folder: integer): string;
21	function IsExtractable(AFilename: string): boolean;	21	function IsExtractable(AFilename: string): boolean;
-		22	function IsDirectoryWritable(const Dir: String): Boolean;
-		23	function IsAtFlobbyDisk(AFileOrDir: string): boolean;
22		24
23	implementation	25	implementation
24		26
25	{$IFNDEF UNICODE}	27	{$IFNDEF UNICODE}
26	type	28	type
27	TCharSet = set of AnsiChar;	29	TCharSet = set of AnsiChar;
28	{$ENDIF}	30	{$ENDIF}
29		31
30	{$IFNDEF UNICODE}	32	{$IFNDEF UNICODE}
31	function CharInSet(C: AnsiChar; const CharSet: TCharSet): Boolean;// overload;	33	function CharInSet(C: AnsiChar; const CharSet: TCharSet): Boolean;// overload;
32	begin	34	begin
33	Result := c in CharSet;	35	Result := c in CharSet;
34	end;	36	end;
35	{$ENDIF}	37	{$ENDIF}
36		38
37	function LooksLikeDir(s: string): boolean;	39	function LooksLikeDir(s: string): boolean;
38	begin	40	begin
39	result := CharInSet(s[Length(s)], ['/', '\']);	41	result := CharInSet(s[Length(s)], ['/', '\']);
40	end;	42	end;
41		43
42	function RawFileCopy(ASrc, ADst: string): boolean;	44	function RawFileCopy(ASrc, ADst: string): boolean;
43	var	45	var
44	SSrc, SDst: TFileStream;	46	SSrc, SDst: TFileStream;
45	begin	47	begin
46	DeleteFile(PChar(ADst));	48	DeleteFile(PChar(ADst));
47		49
48	SSrc := TFileStream.Create(ASrc, fmOpenRead);	50	SSrc := TFileStream.Create(ASrc, fmOpenRead);
49	try	51	try
50	SDst := TFileStream.Create(ADst, fmCreate);	52	SDst := TFileStream.Create(ADst, fmCreate);
51	try	53	try
52	SDst.CopyFrom(SSrc, SSrc.Size);	54	SDst.CopyFrom(SSrc, SSrc.Size);
53	finally	55	finally
54	SDst.Free;	56	SDst.Free;
55	end;	57	end;
56	finally	58	finally
57	SSrc.Free;	59	SSrc.Free;
58	end;	60	end;
59		61
60	result := true;	62	result := true;
61	end;	63	end;
62		64
63	// http://www.delphipraxis.net/32234-shellexecuteandwait-status-abfragen.html	65	// http://www.delphipraxis.net/32234-shellexecuteandwait-status-abfragen.html
64	// Modified. Now CONSOLE compatible and return false if ErrorLevel <> 0	66	// Modified. Now CONSOLE compatible and return false if ErrorLevel <> 0
65	function ShellExecuteAndWait(FileName: string; Params: string): boolean;	67	function ShellExecuteAndWait(FileName: string; Params: string): boolean;
66	var	68	var
67	exInfo: TShellExecuteInfo;	69	exInfo: TShellExecuteInfo;
68	Ph: DWORD;	70	Ph: DWORD;
69	lExitCode: DWord;	71	lExitCode: DWord;
70	begin	72	begin
71	Try	73	Try
72	FillChar(exInfo, SizeOf(exInfo), 0);	74	FillChar(exInfo, SizeOf(exInfo), 0);
73	with exInfo do	75	with exInfo do
74	begin	76	begin
75	cbSize := SizeOf(exInfo);	77	cbSize := SizeOf(exInfo);
76	fMask := SEE_MASK_NOCLOSEPROCESS or SEE_MASK_FLAG_DDEWAIT;	78	fMask := SEE_MASK_NOCLOSEPROCESS or SEE_MASK_FLAG_DDEWAIT;
77	Wnd := GetActiveWindow();	79	Wnd := GetActiveWindow();
78	FileName := ExpandUNCFileName(FileName);	80	FileName := ExpandUNCFileName(FileName);
79	ExInfo.lpVerb := 'open';	81	ExInfo.lpVerb := 'open';
80	ExInfo.lpParameters := PChar(Params);	82	ExInfo.lpParameters := PChar(Params);
81	// ExInfo.lpDirectory := PChar(ExtractFilePath(FileName));	83	// ExInfo.lpDirectory := PChar(ExtractFilePath(FileName));
82	lpFile := PChar(FileName);	84	lpFile := PChar(FileName);
83	nShow := SW_SHOWNORMAL;	85	nShow := SW_SHOWNORMAL;
84	end;	86	end;
85	if ShellExecuteEx(@exInfo) then	87	if ShellExecuteEx(@exInfo) then
86	begin	88	begin
87	Ph := exInfo.HProcess;	89	Ph := exInfo.HProcess;
88	end	90	end
89	else	91	else
90	begin	92	begin
91	WriteLn(SysErrorMessage(GetLastError));	93	WriteLn(SysErrorMessage(GetLastError));
92	Result := False;	94	Result := False;
93	Exit;	95	Exit;
94	end;	96	end;
95	while WaitForSingleObject(ExInfo.hProcess, 50) <> WAIT_OBJECT_0 do ;	97	while WaitForSingleObject(ExInfo.hProcess, 50) <> WAIT_OBJECT_0 do ;
96	(* begin	98	(* begin
97	Application.ProcessMessages;	99	Application.ProcessMessages;
98	end; *)	100	end; *)
99	GetExitCodeProcess(Ph, lExitCode);	101	GetExitCodeProcess(Ph, lExitCode);
100	Result := lExitCode = 0;	102	Result := lExitCode = 0;
101	CloseHandle(Ph);	103	CloseHandle(Ph);
102	Except	104	Except
103	Result := False;	105	Result := False;
104	Exit;	106	Exit;
105	End;	107	End;
106	end;	108	end;
107		109
108	function FileSize(AFilename: string): int64;	110	function FileSize(AFilename: string): int64;
109	var	111	var
110	s: TFileStream;	112	s: TFileStream;
111	begin	113	begin
112	s := TFileStream.Create(AFilename, fmOpenRead or fmShareDenyWrite);	114	s := TFileStream.Create(AFilename, fmOpenRead or fmShareDenyWrite);
113	try	115	try
114	result := s.Size;	116	result := s.Size;
115	finally	117	finally
116	s.Free;	118	s.Free;
117	end;	119	end;
118	end;	120	end;
119		121
120	// http://www.cryer.co.uk/brian/delphi/howto_get_temp.htm	122	// http://www.cryer.co.uk/brian/delphi/howto_get_temp.htm
121	function GetTempDirectory: String;	123	function GetTempDirectory: String;
122	var	124	var
123	tempFolder: array[0..MAX_PATH] of Char;	125	tempFolder: array[0..MAX_PATH] of Char;
124	begin	126	begin
125	GetTempPath(MAX_PATH, @tempFolder);	127	GetTempPath(MAX_PATH, @tempFolder);
126	result := StrPas(tempFolder);	128	result := StrPas(tempFolder);
127	end;	129	end;
128		130
129	function NormalizeLineBreaks(s: string; mode: TLineBreak): string;	131	function NormalizeLineBreaks(s: string; mode: TLineBreak): string;
130	begin	132	begin
131	if mode = lbWindows then	133	if mode = lbWindows then
132	begin	134	begin
133	s := StringReplace(s, #13#10, #10, [rfReplaceAll]);	135	s := StringReplace(s, #13#10, #10, [rfReplaceAll]);
134	s := StringReplace(s, #13, #10, [rfReplaceAll]);	136	s := StringReplace(s, #13, #10, [rfReplaceAll]);
135	s := StringReplace(s, #10, #13#10, [rfReplaceAll]);	137	s := StringReplace(s, #10, #13#10, [rfReplaceAll]);
136	end	138	end
137	else if mode = lbLinux then	139	else if mode = lbLinux then
138	begin	140	begin
139	s := StringReplace(s, #13#10, #13, [rfReplaceAll]);	141	s := StringReplace(s, #13#10, #13, [rfReplaceAll]);
140	s := StringReplace(s, #10, #13, [rfReplaceAll]);	142	s := StringReplace(s, #10, #13, [rfReplaceAll]);
141	end	143	end
142	else if mode = lbMac then	144	else if mode = lbMac then
143	begin	145	begin
144	s := StringReplace(s, #13#10, #10, [rfReplaceAll]);	146	s := StringReplace(s, #13#10, #10, [rfReplaceAll]);
145	s := StringReplace(s, #13, #10, [rfReplaceAll]);	147	s := StringReplace(s, #13, #10, [rfReplaceAll]);
146	end;	148	end;
147	result := s;	149	result := s;
148	end;	150	end;
149		151
150	// http://www.viathinksoft.de/?page=codelib&showid=70	152	// http://www.viathinksoft.de/?page=codelib&showid=70
151	function ExtractFileNameWithoutExt(const fil: string): string;	153	function ExtractFileNameWithoutExt(const fil: string): string;
152	begin	154	begin
153	result := Copy(ExtractFileName(fil), 1, Length(ExtractFileName(fil))-Length(ExtractFileExt(fil)));	155	result := Copy(ExtractFileName(fil), 1, Length(ExtractFileName(fil))-Length(ExtractFileExt(fil)));
154	end;	156	end;
155		157
156	function SearchNextFreeName(s: string; wantDir: boolean): string;	158	function SearchNextFreeName(s: string; wantDir: boolean): string;
157	var	159	var
158	i: integer;	160	i: integer;
159	begin	161	begin
160	if not FileExists(s) and not DirectoryExists(s) then	162	if not FileExists(s) and not DirectoryExists(s) then
161	begin	163	begin
162	result := s;	164	result := s;
163	if wantDir then result := IncludeTrailingPathDelimiter(result);	165	if wantDir then result := IncludeTrailingPathDelimiter(result);
164	Exit;	166	Exit;
165	end;	167	end;
166		168
167	i := 2;	169	i := 2;
168		170
169	if wantDir then	171	if wantDir then
170	begin	172	begin
171	s := ExcludeTrailingPathDelimiter(s);	173	s := ExcludeTrailingPathDelimiter(s);
172	repeat	174	repeat
173	result := Format('%s (%d)', [s, i]);	175	result := Format('%s (%d)', [s, i]);
174	inc(i);	176	inc(i);
175	until not DirectoryExists(result) and not FileExists(result);	177	until not DirectoryExists(result) and not FileExists(result);
176	result := IncludeTrailingPathDelimiter(result);	178	result := IncludeTrailingPathDelimiter(result);
177	end	179	end
178	else	180	else
179	begin	181	begin
180	repeat	182	repeat
181	result := Format('%s (%d)%s', [ExtractFilePath(s)+ExtractFileNameWithoutExt(s), i, ExtractFileExt(s)]);	183	result := Format('%s (%d)%s', [ExtractFilePath(s)+ExtractFileNameWithoutExt(s), i, ExtractFileExt(s)]);
182	inc(i);	184	inc(i);
183	until not DirectoryExists(result) and not FileExists(result);	185	until not DirectoryExists(result) and not FileExists(result);
184	end;	186	end;
185	end;	187	end;
186		188
187	// GetSpecialFolderPath	189	// GetSpecialFolderPath
188	// Ref: http://www.wer-weiss-was.de/theme159/article1058561.html	190	// Ref: http://www.wer-weiss-was.de/theme159/article1058561.html
189	function GetSpecialFolderPath(const Folder: integer): string;	191	function GetSpecialFolderPath(const Folder: integer): string;
190	var	192	var
191	PIDL: PItemIDList;	193	PIDL: PItemIDList;
192	Path: array[0..MAX_PATH] of char;	194	Path: array[0..MAX_PATH] of char;
193	Malloc: IMalloc;	195	Malloc: IMalloc;
194	begin	196	begin
195	Path := '';	197	Path := '';
196	if Succeeded((SHGetSpecialFolderLocation(0, Folder, PIDL))) then	198	if Succeeded((SHGetSpecialFolderLocation(0, Folder, PIDL))) then
197	if (SHGetPathFromIDList(PIDL, Path)) then	199	if (SHGetPathFromIDList(PIDL, Path)) then
198	if Succeeded(ShGetMalloc(Malloc)) then	200	if Succeeded(ShGetMalloc(Malloc)) then
199	begin	201	begin
200	Malloc.Free(PIDL);	202	Malloc.Free(PIDL);
201	Malloc := nil;	203	Malloc := nil;
202	end;	204	end;
203	Result := Path;	205	Result := Path;
204	end;	206	end;
205		207
206	function IsExtractable(AFilename: string): boolean;	208	function IsExtractable(AFilename: string): boolean;
207	var	209	var
208	q: integer;	210	q: integer;
209	uz: TZipMaster19;	211	uz: TZipMaster19;
210	begin	212	begin
211	// TODO: Ist die Funktion gut? Fraglich, ob EOC64 ein Teil von EOC ist.	213	// TODO: Ist die Funktion gut? Fraglich, ob EOC64 ein Teil von EOC ist.
212	uz := TZipMaster19.Create(nil);	214	uz := TZipMaster19.Create(nil);
213	try	215	try
214	q := uz.QueryZip(AFilename);	216	q := uz.QueryZip(AFilename);
215	result := true;	217	result := true;
216	if (q and zqbHasLocal) <> zqbHasLocal then result := false;	218	if (q and zqbHasLocal) <> zqbHasLocal then result := false;
217	if (q and zqbHasCentral) <> zqbHasCentral then result := false;	219	if (q and zqbHasCentral) <> zqbHasCentral then result := false;
218	if ((q and zqbHasEOC) <> zqbHasEOC) and	220	if ((q and zqbHasEOC) <> zqbHasEOC) and
219	((q and zqbHasEOC64) <> zqbHasEOC64) then result := false;	221	((q and zqbHasEOC64) <> zqbHasEOC64) then result := false;
220	finally	222	finally
221	uz.Free;	223	uz.Free;
222	end;	224	end;
223	end;	225	end;
-		226
-		227	// Ref: http://www.delphiarea.com/articles/how-to-find-if-a-directory-is-writable/
-		228	function IsDirectoryWritable(const Dir: String): Boolean;
-		229	var
-		230	TempFile: array[0..MAX_PATH] of Char;
-		231	begin
-		232	if GetTempFileName(PChar(Dir), 'DA', 0, TempFile) <> 0 then
-		233	Result := Windows.DeleteFile(TempFile)
-		234	else
-		235	Result := False;
-		236	end;
-		237
-		238	function IsAtFlobbyDisk(AFileOrDir: string): boolean;
-		239	var
-		240	s: string;
-		241	begin
-		242	s := ExtractFileDrive(AFileOrDir);
-		243	s := UpperCase(s);
-		244
-		245	result := (s = 'A:') or (s = 'B:');
-		246	end;
224		247
225	end.	248	end.
226		249

Subversion Repositories autosfx

autosfx/Functions.pas – Rev 3 → 5