publicu.~pas

duiwenjiandechuli fangbianguanli.

unit PublicU;

interface

uses Windows, Classes, SysUtils, Registry, Forms, ActiveX, ComObj,
     ShlObj, StdCtrls, IniFiles, ShellAPI, Wininet;

type
  PItem = ^TItem;
  TItem = record
    ID, FullID: PItemIDList;
    Folder: Boolean;
    Created: Boolean;
  end;
const
  Cnt_Version           = '0.2 bata';              //版本号
  Cnt_Builder           = '20031119';//编译号
  
function ConvertStr(AStr: String): String;  //处理带'&'的字符
function SetStrLen(AStr: String; ALen: Integer): String;
function GetHomePage: String;  //得到主页地址
function GetFavoritesPath: String; //得到收藏夹路径

procedure DeleteRegUrls;

//读出收藏夹中文件的 Url
function ReadUrl(const AFileName: String): String;
function OpenClient(const AHwnd: THandle; const AClient: String): Boolean;
function GetFileIcon(const AFilename:String; const ASmallIcon:Boolean): HICON;
function GetExePath: String;

function IniValExits(AFile: TIniFile; const ASection, AVal: String): Boolean;
function SavePic(const Sour, Dest: string): Boolean;
procedure DragSaveText(const APath,AText: String);
function StrExits(const AStr: String; AStrList: TStrings): Boolean;

var
  ActiveForm: TForm; //当前激活的窗体
  UrlClose, UseAutoTab: Boolean;
  NewPos, ClosePos, MaxWidth: Integer;
  L,M,R: Integer;

  //UrlList: TStringList;

implementation

{-----------------------------------------------------------------------------
  Function:  PublicU.ConvertStr
  Author:    SQUALL[S&A SSC]
  Date:      2002.9.21
  Arguments: Value: String
  Result:    String
-----------------------------------------------------------------------------}
//处理带'&'的字符
function ConvertStr(AStr: String): String;
var
  I: Integer;
  //tmpStr: String;
  //tmpStrList: TStringList;
begin
  //tmpStr := AStr;
  Result := AStr;
  I := Pos('&', AStr);
  if I>0 then Insert('&', Result, I);
  {tmpStrList := TStringList.Create;
  try
    while I<>0 do
    begin
      tmpStrList.Add(Copy(tmpStr, 1, I-1));
      Delete(tmpStr, 1, I);
      I := Pos('&', tmpStr);
      if I=0 then tmpStrList.Add(tmpStr);
    end;

    if tmpStrList.Count>0 then
    begin
      Result := tmpStrList[0];
      for I:=1 to tmpStrList.Count-1 do
        Result := Result + '&&' + tmpStrList[I];
    end else Result := AStr;
  finally
    tmpStrList.Free;
  end;}
end;

{-----------------------------------------------------------------------------
  Function:  PublicU.SetStrLen
  Author:    SQUALL[S&A SSC]
  Date:      2002.9.21
  Arguments: Value: String,Integer
  Result:    String
-----------------------------------------------------------------------------}
//限至字符长度
function SetStrLen(AStr: String; ALen: Integer): String;
var
  sLen: Integer;
  StrTemp: String;
begin
  StrTemp := AStr;
  if Length(StrTemp) > ALen then
  begin
    StrTemp := Copy(StrTemp, 1, ALen);
    sLen := Length(StrTemp);
    if IsDBCSLeadByte(Byte(StrTemp[sLen])) then Dec(sLen);
    Result := Copy(StrTemp, 1, sLen) + '...';
  end else Result := StrTemp;
end;

{-----------------------------------------------------------------------------
  Function:  PublicU.GetHomePage
  Author:    SQUALL[S&A SSC]
  Date:      2002.9.21
  Arguments: None
  Result:    String
-----------------------------------------------------------------------------}
//得到主页地址
function GetHomePage: String;
var
  Reg: TRegistry;
begin
  Reg := TRegistry.Create;
  try
    Reg.RootKey := HKEY_CURRENT_USER;
    Reg.OpenKey('Software\Microsoft\Internet Explorer\Main',False);
    Result := Reg.ReadString('Start Page');
  finally
    Reg.CloseKey;
    Reg.Free;
  end;
end;

{-----------------------------------------------------------------------------
  Procedure: PublicU.DeleteRegUrls
  Author:    SQUALL[S&A SSC]
  Date:      2002.9.28
  Arguments: None
  Result:    None
-----------------------------------------------------------------------------}
procedure DeleteRegUrls;
var
  Counter: Integer;
begin
  with TRegistry.Create do
  try
    RootKey := HKEY_CURRENT_USER;
    if OpenKey('Software\Microsoft\Internet Explorer\TypedURLs', FALSE) then begin
      for Counter := 1 to 25 do begin
        if ValueExists('Url' +  IntToStr(Counter)) then
          DeleteValue('Url' +  IntToStr(Counter));
      end;
    end;
  finally
    Free;
  end;
end;

{-----------------------------------------------------------------------------
  Function:  PublicU.GetFavoritesPath
  Author:    SQUALL[S&A SSC]
  Date:      2002.9.21
  Arguments: None
  Result:    String
-----------------------------------------------------------------------------}
//得到收藏夹路径
function GetFavoritesPath: String;
var
  shellMalloc: IMalloc;
  ppidl: PItemIdList;
begin
  ppidl := nil;
  try
    if SHGetMalloc(shellMalloc) = NOERROR then
    begin
      SHGetSpecialFolderLocation(Application.Handle, CSIDL_FAVORITES, ppidl);
      SetLength(Result, MAX_PATH);
      SHGetPathFromIDList(ppidl, PChar(Result));
      SetLength(Result, lStrLen(PChar(Result)));
      if Result[Length(Result)]<>'\' then Result := Result+'\';
    end;
  finally
   if ppidl <> nil then shellMalloc.Free(ppidl);
  end;
end;

{-----------------------------------------------------------------------------
  Function:  PublicU.ReadUrl
  Author:    SQUALL[S&A SSC]
  Date:      2002.9.21
  Arguments: Value: String,var String
  Result:    String
-----------------------------------------------------------------------------}
//读出收藏夹中文件的 Url
function ReadUrl(const AFileName: String): String;
var
  UrlFile: TIniFile;
begin
  UrlFile := TIniFile.Create(AFileName);
  try
    Result := UrlFile.ReadString('InternetShortcut', 'URL', 'about:blank');
  finally
    UrlFile.Free;
  end;
end;

{-----------------------------------------------------------------------------
  Function:  PublicU.SplitString
  Author:    SQUALL[S&A SSC]
  Date:      2002.9.21
  Arguments: Value: String,String
  Result:    TStringList
-----------------------------------------------------------------------------}
function SplitString(const ASource, ACh: String): TStringList;
var
 I: Integer;
 Temp: String;
begin
 Result := TStringList.Create;
 Temp := ASource;
 I := Pos(ACh, ASource);

 while I<>0 do
 begin
   Result.Add(Copy(Temp, 0, I-1));
   Delete(Temp, 1, I);
   I := Pos(ACh, Temp);
 end;
 Result.Add(temp);
end;

{-----------------------------------------------------------------------------
  Function:  PublicU.OpenClient
  Author:    SQUALL[S&A SSC]
  Date:      2002.9.21
  Arguments: Value: THandle,String
  Result:    Boolean
-----------------------------------------------------------------------------}
function OpenClient(const AHwnd: THandle; const AClient: String): Boolean;
var
  S,tmp: String;
  I: Integer;
  Reg: TRegistry;
  tmpList: TStringList;
begin
  Result := False;
  Reg := TRegistry.Create;
  try
    Reg.RootKey := HKEY_LOCAL_MACHINE;
    Reg.OpenKey('Software\Clients\'+AClient, FALSE);
    S := Reg.ReadString('');
    Reg.CloseKey;

    Reg.OpenKey('Software\Clients\'+AClient+'\'+S+'\shell\open\command', FALSE);
    S := Reg.ReadString('');
    Reg.CloseKey;
  finally
    Reg.Free;
  end;

  if S <> '' then
  begin
    if Pos('"', S)>0 then S := Copy(S, 2, Length(S));
    if Pos('"', S)>0 then S := Copy(S, 1, Pos('"', S)-1);
    tmpList := SplitString(S, '\');
    if tmpList.Count>0 then
    begin
      for I:=0 to tmpList.Count-2 do
        tmp := tmp+tmpList[I]+'\';
      ShellExecute(AHwnd,'open',pchar(tmpList[tmpList.Count-1]),nil,
                   pchar(tmp),SW_SHOW);
      tmpList.Free;
      Result := True;
    end;
  end;
end;

{-----------------------------------------------------------------------------
  Function:  PublicU.GetFileIcon
  Author:    SQUALL[S&A SSC]
  Date:      2002.9.21
  Arguments: Value: String,Boolean
  Result:    HICON
-----------------------------------------------------------------------------}
//得到文件图标
function GetFileIcon(const AFileName:String; const ASmallIcon:Boolean): HICON;
var
  Flag: Integer;
  info: TShFileInfo;
begin
  if ASmallIcon then
    Flag:=(SHGFI_SMALLICON or SHGFI_ICON)
  else
    Flag:=(SHGFI_LARGEICON or SHGFI_ICON);
  SHGetFileInfo(Pchar(AFileName),0,info,Sizeof(info),Flag);
  Result:=info.hIcon;
end;

{-----------------------------------------------------------------------------
  Function:  PublicU.GetExePath
  Author:    SQUALL[S&A SSC]
  Date:      2002.9.21
  Arguments: None
  Result:    String
-----------------------------------------------------------------------------}
function GetExePath: String;
begin
  Result := ExtractFilePath(Application.ExeName);
end;


function Matchstrings(Source, pattern: string): Boolean;
var
  pSource : array[0..255] of Char;
  pPattern: array[0..255] of Char;

  function MatchPattern(element, pattern: PChar): Boolean;
    function IsPatternWild(pattern: PChar): Boolean;
    begin
      Result := StrScan(pattern, '*') <> nil;
      if not Result then Result := StrScan(pattern, '?') <> nil;
    end;
  begin
    if 0 = StrComp(pattern, '*') then
      Result := True
    else if (element^ = Chr(0)) and (pattern^ <> Chr(0)) then
      Result := False
    else if element^ = Chr(0) then
      Result := True
    else begin
      case pattern^ of
        '*':
          if MatchPattern(element, @pattern[1]) then
            Result := True
          else
            Result := MatchPattern(@element[1], pattern);
        '?': Result := MatchPattern(@element[1], @pattern[1]);
      else
        if element^ = pattern^ then
          Result := MatchPattern(@element[1], @pattern[1])
        else
          Result := False;
      end;
    end;
  end;
begin
  StrPCopy(pSource, Source);
  StrPCopy(pPattern, pattern);
  Result := MatchPattern(pSource, pPattern);
end;

function IniValExits(AFile: TIniFile; const ASection, AVal: String): Boolean;
var
  I: Integer;
  Val,S: String;
  IdentList: TStringList;
begin
  Result := False;
  IdentList := TStringList.Create;
  try
    AFile.ReadSectionValues(ASection, IdentList);
    for I:=0 to IdentList.Count-1 do
    begin
      S := IdentList[I];
      Val := Copy(S, Pos('=', S)+1, Length(S));
      if LowerCase(Trim(Val))=LowerCase(Trim(AVal)) then
      begin
        Result := True;
        Break;
      end;
    end;
  finally
    IdentList.Free;
  end;
end;

{-----------------------------------------------------------------------------
  Function:  PublicU.SavePic
  Author:    SQUALL[S&A SSC]
  Date:      2002.9.29
  Arguments: THandle,String,String
  Result:    Boolean
-----------------------------------------------------------------------------}
function SavePic(const Sour, Dest: string): Boolean;
var
  FileOp: TSHFileOpStruct;
begin
  with FileOp do
  begin
    pFrom := PChar(Sour+#0);
    pTo := PChar(Dest+#0);
    Wnd := 0;
    wFunc := FO_Copy;
    fFlags := FOF_NoConfirmation or FOF_SILENT;
    fAnyOperationsAborted := False;
    hNameMappings := nil;
    lpszProgressTitle := nil;
  end;
  Result := (SHFileOperation(FileOp)=0);
end;

{-----------------------------------------------------------------------------
  Procedure: PublicU.DragSaveText
  Author:    SQUALL[S&A SSC]
  Date:      2002.9.30
  Arguments: String,String
  Result:    None
-----------------------------------------------------------------------------}
procedure DragSaveText(const APath,AText: String);
var
  SaveName: String;
  SaveFile: TStringList;
begin
  SaveName := FormatDateTime('yyyy"-"mm"-"dd"',now)+'.txt';
  SaveFile := TStringList.Create;
  try
    if FileExists(APath+SaveName) then
      SaveFile.LoadFromFile(APath+SaveName);
    SaveFile.Add(AText);
    SaveFile.SaveToFile(APath+SaveName);
  finally
    SaveFile.Free;
  end;
end;

{-----------------------------------------------------------------------------
  Function:  PublicU.StrExits
  Author:    SQUALL[S&A SSC]
  Date:      2002.9.30
  Arguments: String,String
  Result:    Boolean
-----------------------------------------------------------------------------}
function StrExits(const AStr: String; AStrList: TStrings): Boolean;
var
  tmpStr: String;
  I: Integer;
begin
  Result := False;
  tmpStr := LowerCase(Trim(AStr));
  for I:=0 to AStrList.Count-1 do
  begin
    if tmpStr=LowerCase(Trim(AStrList[I])) then
    begin
      Result := True;
      Exit;
    end;
  end;
end;

end.