1 unit utils;
2
3 {
4 Copyright (C) 2005-2008 Olaf Klein, o.b.klein@gpsbabel.org
5
6 This program is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2 of the License, or
9 (at your option) any later version.
10
11 This program is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
15
16 You should have received a copy of the GNU General Public License
17 along with this program; if not, write to the Free Software
18 Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111 USA
19 }
20
21 {
22 function gpsbabel created from old gui GPSBabelGUIDialogU.pas
23 }
24
25 interface
26
27 uses
28 gnugettext,
29 Windows, SysUtils, Classes, StdCtrls, ComCtrls,
30 Registry, ShellAPI, Forms;
31
32 type
33 PBoolean = ^Boolean;
34
gpsbabelnull35 function gpsbabel(const CommandLine: string; Output: TStrings;
36 Fatal: PBoolean = nil; OEMStrings: Boolean = True): Boolean;
37
GetShortNamenull38 function GetShortName(const PathName: string): string;
39
40 procedure StoreProfile(const Tag: Integer; const Value: string); overload;
41 procedure StoreProfile(const Tag, Value: string); overload;
42
ReadProfilenull43 function ReadProfile(const Tag: Integer; const Default: string = ''): string; overload;
ReadProfilenull44 function ReadProfile(const Name: string; const Default: string = ''): string; overload;
45
BackupPropertiesnull46 function BackupProperties(Instance: TObject; Properties: TStrings; Backup: TStringList): Boolean;
47 procedure RestoreProperties(Instance: TObject; Backup: TStringList);
48
49 procedure FixStaticText(AComponent: TComponent);
50
WinOpenFilenull51 function WinOpenFile(const AFile, AParams: string): Boolean;
52 procedure WinOpenURL(const AURL: string);
53
54 procedure UniWrite(Target: TStream; const Str: WideString);
55 procedure UniWriteLn(Target: TStream; const Str: WideString);
56
57 procedure MakeFirstTranslation(AComponent: TComponent);
58
readme_html_pathnull59 function readme_html_path: string;
60
HasUpDownnull61 function HasUpDown(E: TEdit; var UpDown: TUpdown): Boolean;
62
63 procedure StoreBounds(const Name: string; AForm: TForm);
64 procedure RestoreBounds(const Name: string; AForm: TForm);
65
CharCountnull66 function CharCount(const Str: string; const Ch: Char): Integer;
67
68 implementation
69
70 uses
71 common;
72
GetShortNamenull73 function GetShortName(const PathName: string): string;
74 var
75 buffer: array[0..4095] of Char;
76 len: DWORD;
77 begin
78 len := Windows.GetShortPathName(PChar(PathName), @buffer, sizeof(buffer));
79 SetString(Result, buffer, len);
80 end;
81
gpsbabelnull82 function gpsbabel(const CommandLine: string; Output: TStrings;
83 Fatal: PBoolean; OEMStrings: Boolean): Boolean;
84
85 // bigger buffer_size speeds up conversion to screen
86
87 const
88 BUFFER_SIZE = $20000;
89
90 var
91 hRead, hWrite: THandle;
92 ProcessInfo: TProcessInformation;
93 SecurityAttr: TSecurityAttributes;
94 StartupInfo: TStartupInfo;
95 sCmd: string;
96
97 BytesRead, BytesDone: DWORD;
98 buffer_string: string;
99 buffer: PChar;
100 Error: DWORD;
101 Wait_Result: DWORD;
102 s: string;
103 i: Integer;
104
105 begin
106 Result := False;
107
108 // strings are released automatical
109 // so we don't need a try/finally construct for our read buffer
110
111 SetLength(buffer_string, BUFFER_SIZE);
112 buffer := PChar(buffer_string);
113
114 if (Fatal <> nil) then Fatal^ := False;
115
116 if (Copy(CommandLine, 1, 1) = '~') then
117 sCmd := System.Copy(CommandLine, 2, Length(CommandLine) - 1)
118 else
119 sCmd := SysUtils.Format('"%s" %s ', [gpsbabel_exe, CommandLine]);
120
121 SecurityAttr.nLength := sizeof(TSECURITYATTRIBUTES);
122 SecurityAttr.bInheritHandle := true;
123 SecurityAttr.lpSecurityDescriptor := nil;
124
125 if not CreatePipe(hRead, hWrite, @SecurityAttr, $8000) then
126 raise eGPSBabelError.Create(_('Error WINAPI: Could not create "NamedPipe"!'));
127
128 try
129
130 if not FileExists(gpsbabel_exe) then
131 raise eGPSBabelError.Create(_('"gpsbabel.exe" not found!!!'));
132
133 FillChar (StartupInfo, Sizeof (StartupInfo), #0);
134
135 StartupInfo.cb := Sizeof (StartupInfo);
136 StartupInfo.dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
137 StartupInfo.wShowWindow := {SW_HIDE or} SW_SHOWMINNOACTIVE;
138 StartupInfo.hStdInput := GetStdHandle (STD_INPUT_HANDLE);
139 StartupInfo.hStdOutput:= hWrite;
140 StartupInfo.hStdError := hWrite;
141
142 FillChar(ProcessInfo, SizeOf(ProcessInfo), #0);
143
144 if not CreateProcess(nil,
145 pchar(sCmd), nil, nil, true, CREATE_NEW_CONSOLE, // dwCreationFlags, // creation flags
146 nil, nil, StartupInfo, ProcessInfo) then
147 begin
148 Error := GetLastError;
149 raise eGPSBabelError.CreateFmt(
150 _('Could not run "gpsbabel.exe" (Error %d)!'), [Error]);
151 end;
152
153 s := '';
154 Error := 0;
155
156 repeat
157 Wait_Result := WaitforSingleObject(ProcessInfo.hProcess, 10);
158 if PeekNamedPipe(hRead, nil, 0, nil, @BytesRead, nil) then
159 begin
160 if (BytesRead > 0) then
161 Application.ProcessMessages;
162 while (BytesRead > 0) do
163 begin
164 BytesDone := BytesRead;
165 if (BytesDone > (BUFFER_SIZE - 1)) then BytesDone := BUFFER_SIZE - 1;
166 ReadFile(hRead, buffer^, BytesDone, BytesDone, nil);
167 if (BytesDone > 0) then
168 begin
169 buffer[BytesDone] := #0;
170 if OEMStrings then
171 OemToCharBuff(buffer, buffer, BytesDone);
172 s := s + string(buffer);
173 Dec(BytesRead, BytesDone);
174 end;
175 end
176 end;
177 until (Wait_Result = WAIT_OBJECT_0);
178
179 if (Error = 0) then
180 if not GetExitCodeProcess(ProcessInfo.hProcess, Error) then Error := 0;
181
182 if (Error <> 0) and (Error <> 1) then
183 raise eGPSBabelError.CreateFmt(_('"gpsbabel.exe" returned error 0x%x (%d)'), [Error, Error]);
184
185 Output.Clear;
186 while True do
187 begin
188 i := Pos(#13#13, s);
189 if (i <> 0) then System.Delete(s, i, 1)
190 else break;
191 end;
192 Output.SetText(PChar(s));
193
194 Result := True;
195 if (Fatal <> nil) then
196 Fatal^ := (Error = 1);
197
198 finally
199 CloseHandle (hRead);
200 CloseHandle (hWrite);
201 end;
202 end;
203
204 procedure StoreProfile(const Tag: Integer; const Value: string);
205 var
206 reg: TRegistry;
207 str: string;
208 begin
209 if (Tag <= 0) or (Tag > High(Profile)) then Exit;
210
211 str := Profile[Tag];
212 reg := TRegistry.Create;
213 try
214 reg.RootKey := HKEY_CURRENT_USER;
215 if reg.OpenKey('\SOFTWARE\GPSBabel', True) then
216 begin
217 reg.WriteString(str, Value);
218 end;
219 finally
220 reg.Free;
221 end;
222 end;
223
224 procedure StoreProfile(const Tag, Value: string);
225 var
226 reg: TRegistry;
227 begin
228 reg := TRegistry.Create;
229 try
230 reg.RootKey := HKEY_CURRENT_USER;
231 if reg.OpenKey('\SOFTWARE\GPSBabel', True) then
232 begin
233 reg.WriteString(Tag, Value);
234 end;
235 finally
236 reg.Free;
237 end;
238 end;
239
240 function ReadProfile(const Tag: Integer; const Default: string): string; // overload;
241 var
242 str: string;
243 begin
244 if (Tag <= 0) or (Tag > High(Profile)) then Exit;
245 str := Profile[Tag];
246 Result := ReadProfile(str, Default);
247 end;
248
249 function ReadProfile(const Name: string; const Default: string = ''): string; // overload;
250 var
251 reg: TRegistry;
252 begin
253 reg := TRegistry.Create;
254 try
255 reg.RootKey := HKEY_CURRENT_USER;
256 if reg.OpenKey('\SOFTWARE\GPSBabel', True) then
257 begin
258 try
259 Result := reg.ReadString(Name);
260 except
261 Result := Default;
262 end;
263 end;
264 finally
265 reg.Free;
266 end;
267 end;
268
269 function BackupProperties(Instance: TObject; Properties: TStrings; Backup: TStringList): Boolean;
270 var
271 List: TStringList;
272 begin
273 List := TStringList.Create;
274 try
275 Backup.Assign(List);
276 finally
277 List.Free;
278 end;
279 end;
280
281 procedure RestoreProperties(Instance: TObject; Backup: TStringList);
282 begin
283 end;
284
285 procedure FixStaticText(AComponent: TComponent);
286 var
287 i, j: Integer;
288 c: TComponent;
289 s: TStaticText;
290 begin
291 j := AComponent.ComponentCount;
292 for i := 0 to j - 1 do
293 begin
294 c := AComponent.Components[i];
295 if (c.ComponentCount > 0) then FixStaticText(c);
296
297 if not c.InheritsFrom(TStaticText) then Continue;
298
299 s := c as TStaticText;
300 if (s.BorderStyle = sbsNone) then Continue;
301
302 if (s.Alignment = taLeftJustify) then
303 s.Caption := ' ' + s.Caption
304 else if (s.Alignment = taRightJustify) then
305 s.Caption := s.Caption + ' ';
306 end;
307 end;
308
309 function WinOpenFile(const AFile, AParams: string): Boolean;
310 var
311 p: PChar;
312 begin
313 if (AParams = '') then
314 p := nil else
315 p := PChar(AParams);
316 Result := (ShellExecute(0, 'open', PChar(AFile), p, nil, SW_SHOW) > 32);
317 end;
318
319 procedure WinOpenURL(const AURL: string);
320 var
321 i: Integer;
322 reg: TRegistry;
323 cmd: string;
324 prg: string;
325 url: string;
326 begin
327 url := AURL;
328 reg := TRegistry.Create;
329 try
330 reg.RootKey := HKEY_LOCAL_MACHINE;
331 if reg.OpenKeyReadOnly('Software\Classes\HTTP\Shell\Open\Command') then
332 begin
333 prg := reg.ReadString('');
334 if (prg <> '') then
335 begin
336 i := Pos('%1', prg);
337 if (i <> 0) then
338 begin
339 System.Delete(prg, i, 2);
340 System.Insert(url, prg, i);
341 url := '';
342 end;
343
344 if (prg[1] = '"') then
345 begin
346 i := Pos('"', Copy(prg, 2, Length(prg)));
347 if (i = 0) then Exit;
348 cmd := Copy(prg, 2, i - 1);
349 Delete(prg, 1, i + 1);
350 prg := Trim(prg);
351 if (url <> '') then
352 begin
353 if (prg = '') then
354 prg := URL else
355 prg := prg + ' ' + URL;
356 end;
357 if WinOpenFile(cmd, PChar(prg)) then Exit
358 end
359 else
360 if (Pos(' ', prg) <> 0) then
361 begin
362 i := Pos(' ', prg);
363 cmd := Trim(Copy(prg, 1, i - 1));
364 prg := Trim(Copy(prg, i + 1, Length(prg)));
365 if (url <> '') then
366 begin
367 if (prg = '') then
368 prg := URL
369 else
370 prg := Trim(prg) + ' ' + URL;
371 end;
372 if WinOpenFile(cmd, PChar(prg)) then Exit;
373 end
374 else
375 if WinOpenFile(prg, PChar(URL)) then Exit;
376 end;
377 end;
378 finally
379 reg.Free;
380 end;
381 WinOpenFile(AURL, '');
382 end;
383
384 procedure UniWrite(Target: TStream; const Str: WideString);
385 const
386 UniHeader: array[0..1] of Byte = ($FF, $FE);
387 var
388 len: Integer;
389 begin
390 if (Target.Size = 0) then Target.Write(UniHeader, SizeOf(UniHeader));
391 len := Length(Str);
392 if (len > 0) then
393 Target.Write(PWideChar(Str)^, len * 2);
394 end;
395
396 procedure UniWriteLn(Target: TStream; const Str: WideString);
397 begin
398 UniWrite(Target, Str);
399 UniWrite(Target, #13#10);
400 end;
401
402 procedure MakeFirstTranslation(AComponent: TComponent);
403 var
404 lang: string;
405 begin
406 // !!! TRICK !!!
407 lang := GetCurrentLanguage;
408 UseLanguage('en');
409 TranslateComponent(AComponent);
410 if (Copy(lang, 1, 2) <> 'en') then
411 begin
412 UseLanguage(lang);
413 ReTranslateComponent(AComponent);
414 end;
415 // !!! TRICK !!!
416 end;
417
418 function readme_html_path: string;
419 begin
420 Result := ExtractFilePath(ParamStr(0)) + 'gpsbabel.html';
421 if FileExists(Result) then
422 begin
423 while (Pos('\', Result) <> 0) do
424 Result[Pos('\', Result)] := '/';
425 Result := 'file:///' + Result;
426 end
427 else
428 Result := SGPSBabelURL + '/gpsbabel.html';
429 end;
430
431 function HasUpDown(E: TEdit; var UpDown: TUpdown): Boolean;
432 var
433 i: Integer;
434 c: TComponent;
435 o: TComponent;
436 begin
437 Result := False;
438 o := E.Owner;
439 for i := 0 to o.ComponentCount - 1 do
440 begin
441 c := o.Components[i];
442 if (c is TUpDown) and (TUpDown(c).Associate = E) then
443 begin
444 UpDown := TUpDown(c);
445 Result := True;
446 Exit;
447 end;
448 end;
449 end;
450
451 procedure StoreBounds(const Name: string; AForm: TForm);
452 var
453 str: string;
454 begin
455 if (AForm = nil) then Exit;
456
457 if (AForm.WindowState = wsMaximized) then str := 'Y' else str := 'N';
458 str := Format('%s,%d,%d,%d,%d', [str,
459 AForm.Left, AForm.Top, AForm.Width, AForm.Height]);
460 StoreProfile(Name, str);
461 end;
462
463 procedure RestoreBounds(const Name: string; AForm: TForm);
464 var
465 str: string;
466 idx: Integer;
467 lst: TStringList;
468 bds: TRect;
469 begin
470 if (AForm = nil) then Exit;
471
472 str := ReadProfile(Name);
473 if (str = '') then Exit;
474
475 lst := TStringList.Create;
476 try
477 lst.Sorted := False;
478 lst.Duplicates := dupAccept;
479 lst.CommaText := str;
480 try
481 AForm.Position := poDesigned;
482
483 if (StrUpper(PChar(lst[0])) = 'Y') then AForm.WindowState := wsMaximized
484 else AForm.WindowState := wsNormal;
485
486 bds.Left := StrToInt(lst[1]);
487 bds.Top := StrToInt(lst[2]);
488 bds.Right := bds.Left + StrToInt(lst[3]);
489 bds.Bottom := bds.Top + StrToInt(lst[4]);
490
491 AForm.BoundsRect := bds;
492
493 except
494 on E: Exception do;
495 end;
496 finally
497 lst.Free;
498 end;
499 end;
500
501 function CharCount(const Str: string; const Ch: Char): Integer;
502 var
503 i, len: Integer;
504 begin
505 Result := 0;
506 len := Length(Str);
507 for i := 1 to len do
508 if (Str[i] = Ch) then
509 Inc(Result);
510 end;
511
512 var
513 hMutex: THandle;
514
515 initialization
516
517 // Flag for InnoSetup
518 hMutex := CreateMutex(nil, True, 'GPSBabelGUI_mutex');
519
520 finalization
521
522 if (hMutex <> 0) then
523 CloseHandle(hMutex);
524
525 end.
526