[Initranslator-svncheckins] SF.net SVN: initranslator: [243] translator/trunk/src

[<pe...@us...>]

Revision: 243
          http://svn.sourceforge.net/initranslator/?rev=243&view=rev
Author:   peter3
Date:     2007-01-11 14:57:41 -0800 (Thu, 11 Jan 2007)

Log Message:
-----------
- Moved some procedures from Apptils to CommonUtils (and vice versa)
- added Vista specific section to manifest

Modified Paths:
--------------
    translator/trunk/src/AppOptions.pas
    translator/trunk/src/AppUtils.pas
    translator/trunk/src/CommonUtils.pas
    translator/trunk/src/translator.exe.manifest

Modified: translator/trunk/src/AppOptions.pas
===================================================================
--- translator/trunk/src/AppOptions.pas	2006-12-26 23:32:25 UTC (rev 242)
+++ translator/trunk/src/AppOptions.pas	2007-01-11 22:57:41 UTC (rev 243)
@@ -223,7 +223,7 @@
 
 implementation
 uses
-  StrUtils, AppConsts, AppUtils, TntSysUtils;
+  StrUtils, AppConsts, AppUtils, CommonUtils, TntSysUtils;
 
 function StrToFontStyles(const S: WideString): TFontStyles;
 begin

Modified: translator/trunk/src/AppUtils.pas
===================================================================
--- translator/trunk/src/AppUtils.pas	2006-12-26 23:32:25 UTC (rev 242)
+++ translator/trunk/src/AppUtils.pas	2007-01-11 22:57:41 UTC (rev 243)
@@ -1,4 +1,4 @@
-{@abstract(Utility functions and procedures) }
+{@abstract(Application specific utility functions and procedures) }
 {
   Copyright \xA9 2003-2006 by Peter Thornqvist; all rights reserved
 
@@ -28,19 +28,16 @@
 procedure TBMRUSaveToIni(MRU: TTBXMRUList);
 procedure TBMRULoadFromReg(MRU: TTBXMRUList; RootKey: Cardinal; const Path: WideString);
 procedure TBMRUSaveToReg(MRU: TTBXMRUList; RootKey: Cardinal; const Path: WideString);
-// "Fuzzy" in this context just means "remove all white space and control characters before comparing SubStr and Str"
+
 function DetectEncoding(const FileName: WideString): TEncoding;
 function GetAppVersion: WideString;
 function GetCurrentYear: Integer;
 
-// TODO: add JvCreateProcess from JVCL to add support for capturing output?
-
 function ActionShortCutInUse(AM: TActionList; ShortCut: Word): boolean;
 function FindActionShortCut(AM: TActionList; ShortCut: Word): TCustomAction;
 function RemoveActionShortCut(AM: TActionList; ShortCut: Word): integer;
 function _(const ASection, AMsg: WideString): WideString;
 function MyShortCutToText(ShortCut: TShortCut): WideString;
-function BinarySearch(AList: TList; L, R: integer; CompareItem: Pointer; CompareFunc: TListSortCompare; var Index: integer): boolean;
 
 function GlobalLanguageFile: TAppLanguage;
 function GlobalAppOptions: TAppOptions;
@@ -49,30 +46,16 @@
 function GetUserAppDataFolder(const Default: WideString): WideString;
 function GetUserShortcutFile: WideString;
 function GetUserAppOptionsFile: WideString;
-
 procedure HandleFileCreateException(Sender: TObject; E: Exception; const Filename: WideString);
-function GetSpecialFolderLocation(const Folder: Integer): WideString;
+
 function GetAppStoragePath: WideString;
 function AutoDetectCharacterSet(Stream: TStream): TEncoding; overload;
 function AutoDetectCharacterSet(const Filename: WideString): TEncoding; overload;
 function FileCharSetToEncoding(CharSet: TTntStreamCharSet): TEncoding;
 
-function WideStartsText(const ASubText, AText: WideString): Boolean;
-function WideEndsText(const ASubText, AText: WideString): Boolean;
-
-// for Delphi 6
-function ValueFromIndex(S: TTntStrings; i: integer): WideString; overload;
-function ValueFromIndex(S: TStrings; i: integer): AnsiString; overload;
-function strtok(Search, Delim: WideString): WideString;
-
-//procedure SetXPComboStyle(AControl: TControl);
 procedure FixXPStyles(AControl: TWinControl);
-
 function GetPluginsFolder: WideString;
 
-function GetClipboardString(const Section, Name, Value: WideString): WideString;
-function ParseClipboardString(const Str: WideString; out Section, Name, Value: WideString): boolean;
-
 type
   TApplicationServicesFunc = function: IApplicationServices;
 
@@ -82,8 +65,9 @@
 implementation
 uses
   Windows, Forms, Dialogs, Math, Registry, StdCtrls, ExtCtrls, TypInfo,
-  WideIniFiles, Menus, Consts, ShFolder, StrUtils,
-  CommonUtils, ShlObj, ActiveX, TbxUxThemes,
+  Menus, Consts, StrUtils, ShFolder,
+  CommonUtils, WideIniFiles,
+  TbxUxThemes,
   TntWindows, TntSysUtils, TntWideStrUtils;
 
 var
@@ -125,30 +109,6 @@
   end;
 end;
 
-function WideStartsText(const ASubText, AText: WideString): Boolean;
-begin
-  if (ASubText <> '') and (AText <> '') then
-    Result := WideSameText(ASubText, Copy(AText, 1, Length(ASubText)))
-  else
-    Result := false;
-end;
-
-function WideEndsText(const ASubText, AText: WideString): Boolean;
-var
-  L: integer;
-begin
-  if not Win32PlatformIsUnicode then
-    Result := AnsiEndsText(ASubText, AText)
-  else
-  begin
-    L := Length(AText) - Length(ASubText);
-    if (L > 0) and (ASubText <> '') then
-      Result := WideSameText(ASubText, Copy(AText, L + 1, MaxInt))
-    else
-      Result := false;
-  end;
-end;
-
 function GlobalLanguageFile: TAppLanguage;
 begin
   if FLanguageFile = nil then
@@ -171,24 +131,6 @@
     Result := nil;
 end;
 
-function SHGetFolderPathW2(hwnd: HWND; csidl: Integer; hToken: THandle; dwFlags: DWord; pszPath: PWideChar): HRESULT; stdcall; external 'SHFolder.dll' name 'SHGetFolderPathW';
-
-function WideSHGetFolderPath(hwnd: HWND; csidl: Integer; hToken: THandle; dwFlags: DWord; pszPath: PWideChar): HRESULT;
-var
-  AnsiBuff: AnsiString;
-begin
-  if Win32PlatformIsUnicode then
-    Result := SHGetFolderPathW2(hwnd, csidl, hToken, dwFlags, pszPath)
-  else
-  begin
-    SetLength(AnsiBuff, MAX_PATH * 2);
-    Result := SHGetFolderPathA(hwnd, csidl, hToken, dwFlags, PAnsiChar(AnsiBuff));
-    AnsiBuff := AnsiString(PAnsiChar(AnsiBuff));
-    // pszPath :=
-    WStrPLCopy(pszPath, AnsiBuff, Length(AnsiBuff));
-  end;
-end;
-
 function GetUserAppDataFolder(const Default: WideString): WideString;
 begin
   SetLength(Result, MAX_PATH + 1);
@@ -432,31 +374,6 @@
   end;
 end;
 
-function BinarySearch(AList: TList; L, R: integer; CompareItem: Pointer; CompareFunc: TListSortCompare; var Index: integer): boolean;
-var
-  M: integer;
-  CompareResult: integer;
-begin
-  while L <= R do
-  begin
-    M := (L + R) div 2;
-    CompareResult := CompareFunc(AList[M], CompareItem);
-    if (CompareResult < 0) then
-      L := M + 1
-    else if (CompareResult > 0) then
-      R := M - 1
-    else
-    begin
-      Index := M;
-      Result := true;
-      Exit;
-    end;
-  end;
-  // not found, should be located here:
-  Result := false;
-  Index := L;
-end;
-
 procedure HandleFileCreateException(Sender: TObject; E: Exception; const Filename: WideString);
 begin
   if E is EFCreateError then
@@ -465,46 +382,6 @@
     Application.HandleException(Sender);
 end;
 
-function PidlFree(var IdList: PItemIdList): Boolean;
-var
-  Malloc: IMalloc;
-begin
-  Result := False;
-  if IdList = nil then
-    Result := True
-  else
-  begin
-    if Succeeded(SHGetMalloc(Malloc)) and (Malloc.DidAlloc(IdList) > 0) then
-    begin
-      Malloc.Free(IdList);
-      IdList := nil;
-      Result := True;
-    end;
-  end;
-end;
-
-function PidlToPath(IdList: PItemIdList): WideString;
-begin
-  SetLength(Result, MAX_PATH);
-  if Tnt_SHGetPathFromIDListW(IdList, PWideChar(Result)) then
-    Result := WideString(PWideChar(Result))
-  else
-    Result := '';
-end;
-
-function GetSpecialFolderLocation(const Folder: Integer): WideString;
-var
-  FolderPidl: PItemIdList;
-begin
-  if Succeeded(SHGetSpecialFolderLocation(0, Folder, FolderPidl)) then
-  begin
-    Result := PidlToPath(FolderPidl);
-    PidlFree(FolderPidl);
-  end
-  else
-    Result := '';
-end;
-
 function GetAppStoragePath: WideString;
 begin
   // try to get path to \Documents and Settings\<user>\Application Data
@@ -517,88 +394,9 @@
   WideForceDirectories(Result);
 end;
 
-function ValueFromIndex(S: TTntStrings; i: integer): WideString;
-begin
-  if (i >= 0) and (i < S.Count) then
-  begin
-    Result := S[i];
-    i := Pos('=', Result);
-    if i > 0 then
-      Result := Copy(Result, i + 1, MaxInt)
-    else
-      Result := '';
-  end;
-end;
-
-function ValueFromIndex(S: TStrings; i: integer): AnsiString;
-var
-  tmp: TTntStringlist;
-begin
-  tmp := TTntStringlist.Create;
-  try
-    tmp.Assign(S);
-    Result := ValueFromIndex(tmp, i);
-  finally
-    tmp.Free;
-  end;
-end;
-
-{$IFOPT J+}
-{$DEFINE JOPTSET}
-{$ENDIF}
-{$J+ }
-
-function strtok(Search, Delim: WideString): WideString;
-const
-
-  I: integer = 1;
-  Len: integer = 0;
-  PrvStr: WideString = '';
-begin
-  Result := '';
-  if Search <> '' then
-  begin
-    I := 1;
-    PrvStr := Search;
-    Len := Length(PrvStr);
-  end;
-  if PrvStr = '' then
-    Exit;
-  while (i <= Len) and (Pos(PrvStr[i], Delim) > 0) do
-    Inc(I);
-  while (i <= Len) and (Pos(PrvStr[i], Delim) = 0) do
-  begin
-    Result := Result + PrvStr[i];
-    Inc(i);
-  end;
-end;
-{$IFDEF JOPTSET}
-{$J- }
-{$ENDIF JOPTSET}
-{$UNDEF JOPTSET}
-
 type
   TAccessComboBox = class(TCustomComboBox);
 
-procedure SetXPComboStyle(AControl: TControl);
-var
-  i: integer;
-begin
-  if (AControl is TWinControl) then
-    for i := 0 to TWinControl(AControl).ControlCount - 1 do
-    begin
-      if TWinControl(AControl).Controls[i] is TCustomComboBox then
-      begin
-        if Assigned(IsAppThemed) and IsAppThemed {Win32PlatformIsXP} then
-          TAccessComboBox(TWinControl(AControl).Controls[i]).BevelKind := bkNone
-        else
-          TAccessComboBox(TWinControl(AControl).Controls[i]).BevelKind := bkFlat;
-      end;
-      if TWinControl(AControl).Controls[i] is TWinControl then
-        SetXPComboStyle(TWinControl(TWinControl(AControl).Controls[i]));
-    end;
-end;
-
 procedure FixXPStyles(AControl: TWInControl);
 var
   i: integer;
@@ -627,46 +425,7 @@
   Result := WideIncludeTrailingPathDelimiter(WideExtractFilePath(Application.ExeName)) + 'plugins';
 end;
 
-function GetClipboardString(const Section, Name, Value: WideString): WideString;
-var
-  S: TTntStringlist;
-begin
-  S := TTntStringlist.Create;
-  try
-    S.Add(Section);
-    S.Add(Name);
-    S.Add(Value);
-    Result := S.CommaText;
-  finally
-    S.Free;
-  end;
-end;
 
-function ParseClipboardString(const Str: WideString; out Section, Name, Value: WideString): boolean;
-var
-  S: TTntStringlist;
-begin
-  S := TTntStringlist.Create;
-  try
-    S.CommaText := Str;
-    if S.Count > 0 then
-      Section := S[0]
-    else
-      Section := '';
-    if S.Count > 1 then
-      Name := S[1]
-    else
-      Name := '';
-    if S.Count > 2 then
-      Value := S[2]
-    else
-      Value := '';
-    Result := S.Count > 2;
-  finally
-    S.Free;
-  end;
-end;
-
 procedure SaveAndFreeOptions;
 begin
   if FAppOptions <> nil then

Modified: translator/trunk/src/CommonUtils.pas
===================================================================
--- translator/trunk/src/CommonUtils.pas	2006-12-26 23:32:25 UTC (rev 242)
+++ translator/trunk/src/CommonUtils.pas	2007-01-11 22:57:41 UTC (rev 243)
@@ -45,14 +45,17 @@
 function StrDefault(const S, Default: WideString): WideString;
 
 function MyWideDequotedStr(const S: WideString; Quote: WideChar): WideString;
-function AutoWideDequotedStr(const S: WideString):WideString;
+function AutoWideDequotedStr(const S: WideString): WideString;
 function MyWideQuotedStr(const S: WideString; Quote: WideChar): WideString;
 
 function GetMinimizedFilename(const AFilename: WideString; Minimize: boolean): WideString;
 function DoubleQuoteString(const S: WideString; CheckString: boolean = true): WideString;
-
 function RunProcess(const Filename, Params: WideString; WorkingDir: WideString;
   const WaitUntilTerminated, WaitUntilIdle: Boolean; const ShowCmd: Integer; var ResultCode: Cardinal): Boolean;
+function GetSpecialFolderLocation(const Folder: Integer): WideString;
+function WideSHGetFolderPath(hwnd: HWND; csidl: Integer; hToken: THandle; dwFlags: DWord; pszPath: PWideChar): HRESULT;
+function IsFileOpen(const Filename: WideString): boolean;
+
 function SubStrCount(const SubStr, Str: WideString): integer;
 function WideContainsChar(Ch: WideChar; const S: WideString): boolean;
 function IsCharPunct(const S: WideChar): boolean;
@@ -65,15 +68,29 @@
 function IsCharHex(const S: WideChar): boolean;
 function IsCharAlpha(const S: WideChar): boolean;
 
+function GetClipboardString(const Section, Name, Value: WideString): WideString;
+function ParseClipboardString(const Str: WideString; out Section, Name, Value: WideString): boolean;
+
+// for Delphi 6
+function ValueFromIndex(S: TTntStrings; i: integer): WideString; overload;
+function ValueFromIndex(S: TStrings; i: integer): AnsiString; overload;
+function strtok(Search, Delim: WideString): WideString;
+
+function WideStartsText(const ASubText, AText: WideString): Boolean;
+function WideEndsText(const ASubText, AText: WideString): Boolean;
+
+function BinarySearch(AList: TList; L, R: integer; CompareItem: Pointer; CompareFunc: TListSortCompare; var Index: integer): boolean;
+
 implementation
 uses
   Forms, Dialogs, Math, Registry, StrUtils,
+  ShlObj, ActiveX, ShFolder,
   TntWindows, TntSysUtils, TntWideStrUtils;
 
-function AutoWideDequotedStr(const S: WideString):WideString;
+function AutoWideDequotedStr(const S: WideString): WideString;
 begin
   if (Length(S) > 1) and (S[1] in [WideChar(''''), WideChar('"')]) and
-    (S[Length(S)] in [WideChar(''''), WideChar('"')]) then
+  (S[Length(S)] in [WideChar(''''), WideChar('"')]) then
     Result := MyWideDequotedStr(S, S[1])
   else
     Result := S;
@@ -489,6 +506,92 @@
   Result := True;
 end;
 
+function PidlFree(var IdList: PItemIdList): Boolean;
+var
+  Malloc: IMalloc;
+begin
+  Result := False;
+  if IdList = nil then
+    Result := True
+  else
+  begin
+    if Succeeded(SHGetMalloc(Malloc)) and (Malloc.DidAlloc(IdList) > 0) then
+    begin
+      Malloc.Free(IdList);
+      IdList := nil;
+      Result := True;
+    end;
+  end;
+end;
+
+function PidlToPath(IdList: PItemIdList): WideString;
+begin
+  SetLength(Result, MAX_PATH);
+  if Tnt_SHGetPathFromIDListW(IdList, PWideChar(Result)) then
+    Result := WideString(PWideChar(Result))
+  else
+    Result := '';
+end;
+
+function GetSpecialFolderLocation(const Folder: Integer): WideString;
+var
+  FolderPidl: PItemIdList;
+begin
+  if Succeeded(SHGetSpecialFolderLocation(0, Folder, FolderPidl)) then
+  begin
+    Result := PidlToPath(FolderPidl);
+    PidlFree(FolderPidl);
+  end
+  else
+    Result := '';
+end;
+
+function SHGetFolderPathW2(hwnd: HWND; csidl: Integer; hToken: THandle; dwFlags: DWord; pszPath: PWideChar): HRESULT; stdcall; external 'SHFolder.dll' name 'SHGetFolderPathW';
+
+function WideSHGetFolderPath(hwnd: HWND; csidl: Integer; hToken: THandle; dwFlags: DWord; pszPath: PWideChar): HRESULT;
+var
+  AnsiBuff: AnsiString;
+begin
+  if Win32PlatformIsUnicode then
+    Result := SHGetFolderPathW2(hwnd, csidl, hToken, dwFlags, pszPath)
+  else
+  begin
+    SetLength(AnsiBuff, MAX_PATH * 2);
+    Result := SHGetFolderPathA(hwnd, csidl, hToken, dwFlags, PAnsiChar(AnsiBuff));
+    AnsiBuff := AnsiString(PAnsiChar(AnsiBuff));
+    WStrPLCopy(pszPath, AnsiBuff, Length(AnsiBuff));
+  end;
+end;
+
+function IsFileOpen(const Filename: WideString): boolean;
+var
+  hFile: THandle;
+  aLastError, aOldErrorMode: DWORD;
+begin
+  Result := false;
+  // don't display dialog when accessing removable drives without media
+  aOldErrorMode := SetErrorMode(SEM_FAILCRITICALERRORS);
+  try
+    hFile := Tnt_CreateFileW(PWideChar(Filename), OPEN_EXISTING, 0, nil, 0, 0, 0);
+    try
+      if hFile = INVALID_HANDLE_VALUE then
+      begin
+        // get error...
+        aLastError := GetLastError;
+        // check error...
+        Result := aLastError = ERROR_SHARING_VIOLATION;
+        // restore error
+        SetLastError(aLastError);
+      end;
+    finally
+      if hFile <> INVALID_HANDLE_VALUE then
+        CloseHandle(hFile);
+    end;
+  finally
+    SetErrorMode(aOldErrorMode);
+  end;
+end;
+
 function SubStrCount(const SubStr, Str: WideString): integer;
 var tmp: PWideChar;
 begin
@@ -571,5 +674,154 @@
   Result := IsCharType(S, CT_CTYPE1, C1_ALPHA);
 end;
 
+function GetClipboardString(const Section, Name, Value: WideString): WideString;
+var
+  S: TTntStringlist;
+begin
+  S := TTntStringlist.Create;
+  try
+    S.Add(Section);
+    S.Add(Name);
+    S.Add(Value);
+    Result := S.CommaText;
+  finally
+    S.Free;
+  end;
+end;
+
+function ParseClipboardString(const Str: WideString; out Section, Name, Value: WideString): boolean;
+var
+  S: TTntStringlist;
+begin
+  S := TTntStringlist.Create;
+  try
+    S.CommaText := Str;
+    if S.Count > 0 then
+      Section := S[0]
+    else
+      Section := '';
+    if S.Count > 1 then
+      Name := S[1]
+    else
+      Name := '';
+    if S.Count > 2 then
+      Value := S[2]
+    else
+      Value := '';
+    Result := S.Count > 2;
+  finally
+    S.Free;
+  end;
+end;
+
+function ValueFromIndex(S: TTntStrings; i: integer): WideString;
+begin
+  if (i >= 0) and (i < S.Count) then
+  begin
+    Result := S[i];
+    i := Pos('=', Result);
+    if i > 0 then
+      Result := Copy(Result, i + 1, MaxInt)
+    else
+      Result := '';
+  end;
+end;
+
+function ValueFromIndex(S: TStrings; i: integer): AnsiString;
+var
+  tmp: TTntStringlist;
+begin
+  tmp := TTntStringlist.Create;
+  try
+    tmp.Assign(S);
+    Result := ValueFromIndex(tmp, i);
+  finally
+    tmp.Free;
+  end;
+end;
+
+{$IFOPT J+}
+{$DEFINE JOPTSET}
+{$ENDIF}
+{$J+ }
+
+function strtok(Search, Delim: WideString): WideString;
+const
+
+  I: integer = 1;
+  Len: integer = 0;
+  PrvStr: WideString = '';
+begin
+  Result := '';
+  if Search <> '' then
+  begin
+    I := 1;
+    PrvStr := Search;
+    Len := Length(PrvStr);
+  end;
+  if PrvStr = '' then
+    Exit;
+  while (i <= Len) and (Pos(PrvStr[i], Delim) > 0) do
+    Inc(I);
+  while (i <= Len) and (Pos(PrvStr[i], Delim) = 0) do
+  begin
+    Result := Result + PrvStr[i];
+    Inc(i);
+  end;
+end;
+{$IFDEF JOPTSET}
+{$J- }
+{$ENDIF JOPTSET}
+{$UNDEF JOPTSET}
+
+function WideStartsText(const ASubText, AText: WideString): Boolean;
+begin
+  if (ASubText <> '') and (AText <> '') then
+    Result := WideSameText(ASubText, Copy(AText, 1, Length(ASubText)))
+  else
+    Result := false;
+end;
+
+function WideEndsText(const ASubText, AText: WideString): Boolean;
+var
+  L: integer;
+begin
+  if not Win32PlatformIsUnicode then
+    Result := AnsiEndsText(ASubText, AText)
+  else
+  begin
+    L := Length(AText) - Length(ASubText);
+    if (L > 0) and (ASubText <> '') then
+      Result := WideSameText(ASubText, Copy(AText, L + 1, MaxInt))
+    else
+      Result := false;
+  end;
+end;
+
+function BinarySearch(AList: TList; L, R: integer; CompareItem: Pointer; CompareFunc: TListSortCompare; var Index: integer): boolean;
+var
+  M: integer;
+  CompareResult: integer;
+begin
+  while L <= R do
+  begin
+    M := (L + R) div 2;
+    CompareResult := CompareFunc(AList[M], CompareItem);
+    if (CompareResult < 0) then
+      L := M + 1
+    else if (CompareResult > 0) then
+      R := M - 1
+    else
+    begin
+      Index := M;
+      Result := true;
+      Exit;
+    end;
+  end;
+  // not found, should be located here:
+  Result := false;
+  Index := L;
+end;
+
 end.
 

Modified: translator/trunk/src/translator.exe.manifest
===================================================================
--- translator/trunk/src/translator.exe.manifest	2006-12-26 23:32:25 UTC (rev 242)
+++ translator/trunk/src/translator.exe.manifest	2007-01-11 22:57:41 UTC (rev 243)
@@ -7,4 +7,12 @@
          <assemblyIdentity type="win32" name="Microsoft.Windows.Common-Controls" version="6.0.0.0" processorArchitecture="X86" publicKeyToken="6595b64144ccf1df" language="*"/>
       </dependentAssembly>
     </dependency>
+  <!-- this is for Vista -->
+  <ms_asmv3:trustInfo xmlns:ms_asmv3="urn:schemas-microsoft-com:asm.v3"> 
+    <ms_asmv3:security xmlns:ms_asmv3="urn:schemas-microsoft-com:asm.v3"> 
+      <requestedPrivileges> 
+        <requestedExecutionLevel level="asInvoker" uiAccess="true"></requestedExecutionLevel> 
+      </requestedPrivileges> 
+    </ms_asmv3:security> 
+  </ms_asmv3:trustInfo> 
 </assembly>


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.