home *** CD-ROM | disk | FTP | other *** search
/ High Voltage Shareware / high1.zip / high1 / DIR4 / V12N19.ZIP / FILCDR.ZIP / FILECDRL.PAS < prev    next >
Pascal/Delphi Source File  |  1993-07-02  |  4KB  |  130 lines
  1. {$K+}
  2. LIBRARY FileCdrL;
  3. USES WinTypes, Strings, WinProcs;
  4. {$D Copyright (c) 1993 by Neil J. Rubenking}
  5. CONST
  6.   WM_FILESYSCHANGE = $0034;
  7.   hWndInUse        : hWnd = 0;
  8.  
  9.   FUNCTION FileCdr(FILECDRPROC : TFarProc) : LongInt; FAR;
  10.     EXTERNAL 'KERNEL' Index 130;
  11.  
  12.   PROCEDURE FileCdrProc(wActionCode : Word; lpszPath : PChar);Export;
  13.   BEGIN
  14.     SendMessage(hWndInUse, WM_FILESYSCHANGE, Hi(wActionCode),
  15.       LongInt(lpszpath));
  16.   END;
  17.  
  18.   FUNCTION FileCdrInstall(H : hWnd) : Bool; Export;
  19.   BEGIN
  20.     FileCdrInstall := FALSE;
  21.     IF hWndInUse <> 0 THEN Exit;
  22.     IF NOT Bool(LoWord(FileCdr(@FileCdrProc))) THEN Exit;
  23.     hWndInUse := H;
  24.     FileCdrInstall := TRUE;
  25.   END;
  26.  
  27.   FUNCTION FileCdrUninstall(H : hWnd) : Bool; Export;
  28.   BEGIN
  29.     FileCdrUninstall := FALSE;
  30.     IF hWndInUse = 0 THEN Exit;
  31.     IF hWndInUse <> H THEN Exit;
  32.     FileCdr(NIL);
  33.     hWndInUse  := 0;
  34.     FileCdrUninstall := TRUE;
  35.   END;
  36.  
  37.   FUNCTION GetEventName(buff : PChar; fEvent, buffLen :
  38.     Word) : PChar; Export;
  39.   BEGIN
  40.     CASE fEvent OF
  41.       0, $3C : StrLCopy(buff, 'Create file', BuffLen);
  42.       1, $41 : StrLCopy(buff, 'Delete file', BuffLen);
  43.       2, $56 : StrLCopy(buff, 'Rename file/dir', BuffLen);
  44.       3, $43 : StrLCopy(buff, 'Get/set file attrs', BuffLen);
  45.                {no event for GET file attr from a WinApp}
  46.          $5A : StrLCopy(buff, 'Create unique file', BuffLen);
  47.                {from DOS box, this function comes as 0}
  48.          $57 : StrLCopy(buff, 'Set file date/time', BuffLen);
  49.                {Schulman mentions this, but it don't happen}
  50.          $5B : StrLCopy(buff, 'Create new file', BuffLen);
  51.                {from DOS box, this function comes as 0}
  52.       7, $39 : StrLCopy(buff, 'Create directory', BuffLen);
  53.       8, $3A : StrLCopy(buff, 'Delete directory', BuffLen);
  54.          $6C : StrLCopy(buff, 'Extended open', BuffLen);
  55.                {from DOS box, this function is ignored}
  56.       ELSE StrLCopy(buff, 'UNKNOWN', BuffLen);
  57.     END;
  58.     GetEventName := buff;
  59.   END;
  60.  
  61.   (* Code for Visual BASIC support begins here *)
  62. CONST TextHandle : hWnd = 0;
  63. VAR OldProc      : TFarProc;
  64.  
  65.   PROCEDURE SendVbMessage(wAc : Word; lpszPath : PChar);
  66.     {used by both FileCdrProcVB and NewVBWinProc}
  67.   VAR
  68.     Len, fBegin : Word;
  69.     P           : PChar;
  70.   BEGIN
  71.     Len := StrLen(lpszpath) + 30;
  72.     CASE wAc OF
  73.       2, $56 : Inc(Len, StrLen(StrEnd(lpszpath)+1));
  74.     END;
  75.     GetMem(P, Len);
  76.       {start with W for Windows or D for DOS box}
  77.     IF wAc > 9 THEN StrCopy(P, '(W)'#9) ELSE StrCopy(P, '(D)'#9);
  78.       {insert the event name starting at 4th char}
  79.     GetEventName(P+4, wAc, Len);
  80.     fBegin := StrLen(P);
  81.     StrCat(P, #9);
  82.       {append the file name}
  83.     StrCat(P, lpszpath);
  84.       {if RENAME, append the OTHER file name}
  85.     IF (wAc = 2) OR (wAc = $56) THEN
  86.       BEGIN
  87.         StrCat(P, ' TO ');
  88.         StrCat(P, StrEnd(lpszpath)+1);
  89.       END;
  90.       {uppercase the filename portion only}
  91.     StrUpper(P + fBegin);
  92.     SendMessage(TextHandle, WM_SETTEXT, 0, LongInt(P));
  93.     FreeMem(P, Len);
  94.   END;
  95.  
  96.   PROCEDURE FileCdrProcVB(wActionCode: Word; lpszPath: PChar); Export;
  97.   BEGIN
  98.     IF hWndInUse = 0 THEN Exit;
  99.     SendVbMessage(Hi(wActionCode), lpszPath);
  100.   END;
  101.  
  102.   FUNCTION NewVBWinProc(Window : hWnd; Message, wParam : Word;
  103.     lParam : LongInt) : LongInt; EXPORT;
  104.   BEGIN
  105.     NewVBWinProc := CallWindowProc(OldProc, Window, Message, wParam,
  106.       lParam);
  107.     IF Message = WM_FILESYSCHANGE THEN
  108.       SendVBMessage(wParam, PChar(lParam));
  109.   END;
  110.  
  111.   FUNCTION FileCdrInstallVB(H, TextH : hWnd) : Bool; Export;
  112.   BEGIN
  113.     FileCdrInstallVB := FALSE;
  114.     IF hWndInUse <> 0 THEN Exit;
  115.     IF NOT Bool(LoWord(FileCdr(@FileCdrProcVB))) THEN Exit;
  116.     hWndInUse  := H;
  117.     TextHandle := TextH;
  118.     OldProc := TFarProc(GetWindowLong(hWndInUse, gwl_WndProc));
  119.     SetWindowLong(hWndInUse, gwl_WndProc, LongInt(@NewVBWinProc));
  120.     FileCdrInstallVB := TRUE;
  121.   END;
  122.  
  123. EXPORTS
  124.   FileCdrInstall     INDEX 1,
  125.   FileCdrUnInstall   INDEX 2,
  126.   GetEventName       INDEX 3,
  127.   FileCdrInstallVB   INDEX 4;
  128. BEGIN
  129. END.
  130.