1 (*
2 * The contents of this file are subject to the Mozilla Public License
3 * Version 1.1 (the "License"); you may not use this file except in
4 * compliance with the License. You may obtain a copy of the License at
5 * http://www.mozilla.org/MPL/
6 *
7 * Software distributed under the License is distributed on an "AS IS"
8 * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the
9 * License for the specific language governing rights and limitations
10 * under the License.
11 *
12 * The Initial Developer of this code is John Hansen.
13 * Portions created by John Hansen are Copyright (C) 2009 John Hansen.
14 * All Rights Reserved.
15 *
16 *)
17 unit uCmdLineUtils;
18
19 interface
20
21 uses
22 Classes;
23
progNamenull24 function progName : string;
25 procedure PrintVersion(const ts : string = '');
26 procedure PrintUsageError(const ts : string = '');
redirectErrorsToFilenull27 function redirectErrorsToFile : boolean;
28 procedure setErrorOutputFile(var F : TextFile);
getIncludePathnull29 function getIncludePath : string;
30
31 implementation
32
33 uses
34 SysUtils, ParamUtils, uVersionInfo, uLocalizedStrings;
35
progNamenull36 function progName : string;
37 begin
38 Result := ExtractFileName(ParamStr(0));
39 Result := ChangeFileExt(Result, '');
40 end;
41
42 procedure PrintVersion(const ts : string);
43 var
44 V : TVersionInfo;
45 app, tmp : string;
46 begin
47 app := ParamStr(0);
48 V := GetVersionInfo(app);
49 tmp := V.ProductName + VersionString + V.ProductVersion + ' (' + V.FileVersion;
50 if ts <> '' then
51 tmp := tmp + ',' + BuiltString + ts;
52 tmp := tmp + ')';
53 Writeln(tmp);
54 Writeln(' ' + V.LegalCopyright);
55 end;
56
57 procedure PrintUsageError(const ts : string);
58 begin
59 PrintVersion(ts);
60 Writeln(Format(UsageErrorMessage, [progName]));
61 end;
62
redirectErrorsToFilenull63 function redirectErrorsToFile : boolean;
64 begin
65 Result := ParamSwitch('-E', false);
66 end;
67
68 procedure setErrorOutputFile(var F : TextFile);
69 var
70 val, dir : string;
71 begin
72 val := '';
73 if ParamSwitch('-E', false) then
74 begin
75 val := ParamValue('-E', false);
76 dir := ExtractFilePath(val);
77 if dir <> '' then
78 ForceDirectories(dir);
79 end;
80 AssignFile(F, val);
81 Rewrite(F);
82 end;
83
getIncludePathnull84 function getIncludePath : string;
85 begin
86 Result := ExtractFilePath(ParamStr(0));
87 if ParamSwitch('-I', false) then
88 begin
89 Result := ParamValue('-I', false);
90 end;
91 end;
92
93 end.
94