source: cprs/branches/ScanSourceForConstants/SearchMissingU.pas@ 1671

Last change on this file since 1671 was 461, checked in by Kevin Toppenberg, 16 years ago

Initial upload of Multi-language support appt: ScanSourceForConstants

File size: 6.4 KB
Line 
1unit SearchMissingU;
2
3interface
4
5 uses
6 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
7 Dialogs, StdCtrls, Buttons;
8
9 type
10 TSearchConstsForm = class(TForm)
11 Memo: TMemo;
12 OKBtn: TBitBtn;
13 SearchBtn: TBitBtn;
14 OpenDialog1: TOpenDialog;
15 AbortBtn: TBitBtn;
16 cbReportChanges: TCheckBox;
17 procedure FormCreate(Sender: TObject);
18 procedure FormDestroy(Sender: TObject);
19 procedure SearchBtnClick(Sender: TObject);
20 procedure FormShow(Sender: TObject);
21 procedure OKBtnClick(Sender: TObject);
22 procedure AbortBtnClick(Sender: TObject);
23 private
24 { Private declarations }
25 ConstNames : TStringList;
26 AbortScan : boolean;
27 procedure LoadConsts;
28 procedure ScanAll;
29 procedure ScanTree(RootDir : string);
30 function Scan1File(FilePathName : string) : integer;
31 function Report1File(FilePathName : string) : integer;
32 function CheckOneConst(oneConst : string) : boolean;
33 public
34 { Public declarations }
35 function Exists(s : string) : boolean;
36 end;
37
38 var
39 SearchConstsForm: TSearchConstsForm;
40
41implementation
42
43 {$R *.dfm}
44
45 uses ShowConstsU, SrcScannerU, StrUtils;
46
47 procedure TSearchConstsForm.ScanAll;
48 var
49 RootDir : string;
50 begin
51 if OpenDialog1.Execute then begin
52 RootDir := ExtractFilePath(OpenDialog1.FileName);
53 ScanTree(RootDir);
54 Memo.Lines.Add('Done.');
55 end;
56 end;
57
58 procedure TSearchConstsForm.ScanTree(RootDir : string);
59 var
60 SrchRec : TSearchRec;
61 NumErrorFiles : integer;
62 NoAsk : boolean;
63 NumProbs : integer;
64 begin
65 NumErrorFiles := 0;
66 AbortScan := false; NoAsk := false;
67 if FindFirst(RootDir+'*.*', faDirectory, SrchRec)=0 then begin
68 repeat
69 Application.ProcessMessages;
70 if SrchRec.Attr = faDirectory then begin
71 if (SrchRec.Name<>'.') and ((SrchRec.Name<>'..')) then begin
72 ScanTree(RootDir+SrchRec.Name+'\');
73 end;
74 end else begin
75 if ExtractFileExt(SrchRec.Name)= '.pas' then begin
76 if cbReportChanges.Checked = true then begin
77 NumProbs := Report1File(RootDir+SrchRec.Name);
78 end else begin
79 NumProbs := Scan1File(RootDir+SrchRec.Name);
80 end;
81 if NumProbs > 0 then begin
82 NumErrorFiles := NumErrorFiles + 1;
83 if (NumErrorFiles > 4) and (NoAsk=false) then begin
84 case MessageDlg('5 files with errors found. Continue?', mtError, mbYesNoCancel,0) of
85 mrYes : NoAsk := true;
86 mrNo : AbortScan := true;
87 mrCancel : {do nothing, ask again}
88 end; {case}
89 end;
90 end;
91 end;
92 end;
93 until (FindNext(SrchRec)<>0) or AbortScan;
94 end;
95 FindClose(SrchRec);
96 end;
97
98 function TSearchConstsForm.Scan1File(FilePathName : string) : integer;
99 //returns number of problems.
100 var
101 Lines : TStringList;
102 i,p : integer;
103 oneLine : string;
104 oneConst : string;
105 found : integer;
106 begin
107 Lines := TStringList.Create;
108 found := 0;
109 Lines.LoadFromFile(FilePathName);
110 Memo.Lines.Add('Scanning: '+FilePathName);
111 for i := 0 to Lines.Count-1 do begin
112 oneLine := Lines.Strings[i];
113 while Pos('DKLangConstW',oneLine)>0 do begin
114 p := Pos('DKLangConstW',oneLine)+13;
115 oneLine := MidStr(oneLine,p+1,999);
116 p := Pos('''',oneLine);
117 oneConst := MidStr(oneLine,1,p-1);
118 if CheckOneConst(oneConst) = false then found := found + 1;
119 oneLine := MidStr(oneLine,p+1,999);
120 end;
121 end;
122 //if found > 0 then edit file??
123 Lines.Free;
124 Result := found;
125 end;
126
127 function TSearchConstsForm.Report1File(FilePathName : string) : integer;
128 //returns number of problems.
129 var
130 Lines : TStringList;
131 i,p : integer;
132 oneLine : string;
133 oneConst : string;
134 found : integer;
135 begin
136 Lines := TStringList.Create;
137 found := 0;
138 Lines.LoadFromFile(FilePathName);
139 Memo.Lines.Add(' --------------------------------------------------------------- ');
140 Memo.Lines.Add(' ');
141 Memo.Lines.Add(' File: '+FilePathName);
142 Memo.Lines.Add('Line#');
143 for i := 0 to Lines.Count-1 do begin
144 oneLine := Lines.Strings[i];
145 if Pos('//kt',oneLine)>0 then begin
146 Memo.Lines.Add(IntToStr(i)+': '+oneLine)
147 end;
148 end;
149 Lines.Free;
150 Result := found;
151 end;
152
153 function TSearchConstsForm.CheckOneConst(oneConst : string) : boolean;
154 //return TRUE if OK, FALSE if had to be added.
155 begin
156 Result := true;
157 if not Exists(oneConst) then begin
158 if Memo.Lines.IndexOf(oneConst) < 0 then begin
159 Memo.Lines.Add(oneConst);
160 Result := false;
161 end;
162 end;
163 end;
164
165 function TSearchConstsForm.Exists(s : string) : boolean;
166 begin
167 Result := ConstNames.IndexOf(s) > -1;
168 end;
169
170 procedure TSearchConstsForm.LoadConsts;
171 var i : integer;
172 s : string;
173 begin
174 ConstNames.Clear;
175 for i := 0 to ConstantsOutputForm.ConstantsMemo.Lines.Count-1 do begin
176 s := ConstantsOutputForm.ConstantsMemo.Lines.Strings[i];
177 s := piece(s,'=',1);
178 ConstNames.Add(s);
179 end;
180 end;
181
182 procedure TSearchConstsForm.FormCreate(Sender: TObject);
183 begin
184 ConstNames := TStringList.Create;
185 end;
186
187 procedure TSearchConstsForm.FormDestroy(Sender: TObject);
188 begin
189 ConstNames.Free;
190 end;
191
192procedure TSearchConstsForm.SearchBtnClick(Sender: TObject);
193var
194 fName: string;
195
196begin
197 OKBtn.Enabled := false;
198 AbortBtn.Enabled := true;
199 SearchBtn.Enabled := false;
200 Memo.Lines.Clear;
201 ScanAll();
202 OKBtn.Enabled := true;
203 AbortBtn.Enabled := false;
204 SearchBtn.Enabled := true;
205 if cbReportChanges.Checked = true then begin
206 if MessageDlg('Save Report?',mtConfirmation,mbOKCancel,0) = mrOK then begin
207 if OpenDialog1.Execute then begin
208 fName := OpenDialog1.FileName;
209 Memo.Lines.SaveToFile(fName);
210 end;
211 end;
212 end;
213end;
214
215procedure TSearchConstsForm.FormShow(Sender: TObject);
216begin
217 LoadConsts;
218end;
219
220procedure TSearchConstsForm.OKBtnClick(Sender: TObject);
221begin
222 Hide;
223end;
224
225procedure TSearchConstsForm.AbortBtnClick(Sender: TObject);
226begin
227 AbortScan := true;
228end;
229
230end.
231
Note: See TracBrowser for help on using the repository browser.