home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 March / Chip_2002-03_cd1.bin / zkuste / delphi / kompon / d5 / cak / CAKDIR.ZIP / Links.pas < prev    next >
Pascal/Delphi Source File  |  2001-04-23  |  4KB  |  156 lines
  1. unit Links;
  2.  
  3. interface
  4.  
  5. function SpecialDirectory(ID: integer): string;
  6. function CreateFolder(Foldername: string): boolean;
  7. function CreateLink(lpszPathObj, lpszPathLink, lpszDesc: string): boolean;
  8. function Like(const AString, APattern: string): boolean;
  9.  
  10. implementation
  11.  
  12. uses Windows, SysUtils, ShellApi, ActiveX, ComObj, ShlObj;
  13.  
  14.  
  15. const
  16.   IID_IPersistFile: TGUID = (D1: $0000010B; D2: $0000; D3: $0000;
  17.     D4: ($C0, $00, $00, $00, $00, $00, $00, $46));
  18.  
  19. function SpecialDirectory(ID: integer): string;
  20. var 
  21.   pidl: PItemIDList;
  22.   Path: PChar;
  23. begin
  24.   if SUCCEEDED(SHGetSpecialFolderLocation(0, ID, pidl)) then 
  25.   begin
  26.     Path := StrAlloc(MAX_PATH);
  27.     SHGetPathFromIDList(pidl, Path);
  28.     Result := string(Path);
  29.     if Result[length(Result)] <> '\' then
  30.       Result := Result + '\';
  31.   end;
  32. end; {SpecialDirectory}
  33.  
  34. function CreateFolder(Foldername: string): boolean;
  35. begin
  36.   Result := False;
  37.   SetLastError(0);
  38.   CreateDirectory(PChar(Foldername), nil);
  39.   if (GetLastError() = 0) or (GetLastError() = ERROR_ALREADY_EXISTS) then
  40.     Result := True;
  41. end; {CreateFolder}
  42.  
  43. function CreateLink(lpszPathObj, lpszPathLink, lpszDesc: string): boolean;
  44. var 
  45.   psl: IShellLink;
  46.   ppf: IPersistFile;
  47. begin
  48.   Result := False;
  49.   if SUCCEEDED(CoCreateInstance(CLSID_ShellLink, nil, CLSCTX_INPROC_SERVER,
  50.     IID_IShellLinkA, psl)) then 
  51.   begin
  52.     psl.SetPath(PChar(lpszPathObj));
  53.     psl.SetDescription(PChar(lpszDesc));
  54.     if SUCCEEDED(psl.QueryInterface(IID_IPersistFile, ppf)) then 
  55.     begin
  56.       ppf.Save(StringToOLEStr(lpszPathLink), True);
  57.       Result := True;
  58.     end;
  59.   end;
  60. end; {CreateLink}
  61.  
  62. function Like(const AString, APattern: string): boolean;
  63. var
  64.   StringPtr, PatternPtr: PChar;
  65.   StringRes, PatternRes: PChar;
  66. begin
  67.   Result     := False;
  68.   StringPtr  := PChar(AnsiLowerCase(AString));
  69.   PatternPtr := PChar(AnsiLowerCase(APattern));
  70.   StringRes  := nil;
  71.   PatternRes := nil;
  72.   repeat
  73.     repeat // ohne vorangegangenes "*"
  74.       case PatternPtr^ of
  75.         #0: 
  76.         begin
  77.           Result := StringPtr^ = #0;
  78.           if Result or (StringRes = nil) or (PatternRes = nil) then
  79.             Exit;
  80.           StringPtr  := StringRes;
  81.           PatternPtr := PatternRes;
  82.           Break;
  83.         end;
  84.         '*': 
  85.         begin
  86.           inc(PatternPtr);
  87.           PatternRes := PatternPtr;
  88.           Break;
  89.         end;
  90.         '?': 
  91.         begin
  92.           if StringPtr^ = #0 then
  93.             Exit;
  94.           inc(StringPtr);
  95.           inc(PatternPtr);
  96.         end;
  97.         else 
  98.         begin
  99.           if StringPtr^ = #0 then
  100.             Exit;
  101.           if StringPtr^ <> PatternPtr^ then 
  102.           begin
  103.             if (StringRes = nil) or (PatternRes = nil) then
  104.               Exit;
  105.             StringPtr  := StringRes;
  106.             PatternPtr := PatternRes;
  107.             Break;
  108.           end
  109.           else 
  110.           begin
  111.             inc(StringPtr);
  112.             inc(PatternPtr);
  113.           end;
  114.         end;
  115.       end;
  116.     until False;
  117.     repeat // mit vorangegangenem "*"
  118.       case PatternPtr^ of
  119.         #0: 
  120.         begin
  121.           Result := True;
  122.           Exit;
  123.         end;
  124.         '*': 
  125.         begin
  126.           inc(PatternPtr);
  127.           PatternRes := PatternPtr;
  128.         end;
  129.         '?': 
  130.         begin
  131.           if StringPtr^ = #0 then
  132.             Exit;
  133.           inc(StringPtr);
  134.           inc(PatternPtr);
  135.         end;
  136.         else 
  137.         begin
  138.           repeat
  139.             if StringPtr^ = #0 then
  140.               Exit;
  141.             if StringPtr^ = PatternPtr^ then
  142.               Break;
  143.             inc(StringPtr);
  144.           until False;
  145.           inc(StringPtr);
  146.           StringRes := StringPtr;
  147.           inc(PatternPtr);
  148.           Break;
  149.         end;
  150.       end;
  151.     until False;
  152.   until False;
  153. end; {Michael Winter}
  154.  
  155.  
  156. end.