home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 November / Chip_2002-11_cd1.bin / zkuste / delphi / kompon / d456 / CAJSCRPT.ZIP / ifps3 / ifpidll2.pas < prev    next >
Pascal/Delphi Source File  |  2002-07-06  |  2KB  |  90 lines
  1. {Dll library (compiler)}
  2. unit ifpidll2;
  3.  
  4. {$I ifps3_def.inc}
  5. interface
  6. {
  7.  
  8.   Function FindWindow(c1, c2: PChar): Cardinal; external 'FindWindow@user32.dll stdcall';
  9.  
  10. }
  11. uses
  12.   ifps3common, ifpscomp, ifps3utl;
  13.  
  14. {Assign this to the TIFPSCompiler.OnExternal event} 
  15. function DllExternalProc(Sender: TIFPSPascalCompiler; const Name, Decl, FExternal: string): PIFPSRegProc;
  16. type
  17.   {Used to store the possible calling conventions}
  18.   TDllCallingConvention = (clRegister, clPascal, ClCdecl, ClStdCall);
  19.  
  20. var
  21. {The default CC}
  22.   DefaultCC: TDllCallingConvention;
  23. implementation
  24.  
  25. function DllExternalProc(Sender: TIFPSPascalCompiler; const Name, Decl, FExternal: string): PIFPSRegProc;
  26. var
  27.   FuncName,
  28.   FuncCC,
  29.   s: string;
  30.   CC: TDllCallingConvention;
  31.  
  32. begin
  33.   FuncCC := FExternal;
  34.   if (pos('@', FuncCC) = 0) then
  35.   begin
  36.     Sender.MakeError('', ecCustomError, 'Invalid External');
  37.     Result := nil;
  38.     exit;
  39.   end;
  40.   FuncName := copy(FuncCC, 1, pos('@', FuncCC)-1)+#0;
  41.   delete(FuncCc, 1, length(FuncName));
  42.   if pos(' ', Funccc) <> 0 then
  43.   begin
  44.     FuncName := copy(FuncCc, 1, pos(' ',FuncCC)-1)+#0+FuncName;
  45.     Delete(FuncCC, 1, pos(' ', FuncCC));
  46.     FuncCC := FastUpperCase(FuncCC);
  47.     if FuncCC = 'STDCALL' then cc := ClStdCall else
  48.     if FuncCC = 'CDECL' then cc := ClCdecl else
  49.     if FuncCC = 'REGISTER' then cc := clRegister else
  50.     if FuncCC = 'PASCAL' then cc := clPascal else
  51.     begin
  52.       Sender.MakeError('', ecCustomError, 'Invalid Calling Convention');
  53.       Result := nil;
  54.       exit;
  55.     end;
  56.   end else
  57.   begin
  58.     FuncName := FuncCC+#0+FuncName;
  59.     FuncCC := '';
  60.     cc := DefaultCC;
  61.   end;
  62.   FuncName := 'dll:'+FuncName+char(cc);
  63.   s := Decl;
  64.   if GRFW(s) = '-1' then
  65.   begin
  66.     FuncName := FuncName + #0;
  67.   end else
  68.     FuncName := FuncName + #1;
  69.   while length(s) > 0 do
  70.   begin
  71.     FuncCC := grfw(s);
  72.     if funcCC[1] = '!' then
  73.       FuncName := FuncName + #1
  74.     else
  75.       FuncName := FuncName + #0;
  76.     grfw(s);
  77.   end;
  78.   New(Result);
  79.   Result^.ImportDecl := FuncName;
  80.   Result^.Decl := Decl;
  81.   Result^.Name := Name;
  82.   Result^.FExportName := False;
  83.   Result^.NameHash := MakeHash(Name);
  84. end;
  85.  
  86. begin
  87.   DefaultCc := clRegister;
  88. end.
  89.  
  90.