headpars.~pas

C++ 头文件转换为Delphi接口文件地工具

            begin
              Dec(Commentaar[0]);
              SkipSpaces(Commentaar);
              write(Commentaar,' }')
            end;
            SkipSpaces(Line[j]);
            if (Pos('{',Line[j]) > 0) and (Pos('}',Line[j]) > 0) then
            begin
              Commentaar := Copy(Line[j],Pos('{',Line[j]),Length(Line[j]));
              Line[j,0] := Chr(Pos('{',Line[j])-1);
              SkipSpaces(Line[j])
            end
            else Commentaar := '';

            if (j = 1) then
            begin
            { writeln(Line[j]) { proc name & type
              writeln; }
              if Explicit then
              begin
                write('var ');
                trailing := 4;
                { get last word }
                k := Length(Line[1]);
                while (k > 1) and not (Line[1,k] in [' ','*']) do Dec(k);
                { default = int }
                if (k = 1) and not (Line[1,1] in [' ','*']) then { int }
                begin
                  { skip, for now }
                end
                else
                  Inc(k);
                Name := '';
                repeat
                  Name := Name + UpCase(Line[1,k]);
                  write(Line[1,k]);
                  write(def,Line[1,k]); { explicit }
                  Inc(trailing);
                  Inc(k)
                until k > Length(Line[1]);
                Dec(k);
                while (k > 1) and not (Line[1,k] in [' ','*']) do Dec(k);
                writeln(def); { explicit }
                { default = int }
                if (k = 1) and not (Line[1,1] in [' ','*']) then { int }
                  Line[1] := 'INT'
                else
                  Line[1,0] := Chr(k);
                SkipSpaces(Line[1]);
                { got last word }
                Upper(Line[1]);
                if (Pos('VOID ',Line[1]) = 1) or (Pos('void ',Line[1]) = 1)  then
                begin
                  Inc(trailing,11-2); { 3.06 }
                  write(': procedure')
                end
                else
                begin
                  Inc(trailing,10-2);
                  write(': function')
                end
              end
              else { implicit }
              begin
                if (Pos('void ',Line[1]) = 1) then
                begin
                  trailing := 10;
                  writeln;
                  write('procedure ');
                  write(def,'procedure ')
                end
                else
                begin
                  trailing := 9;
                  writeln;
                  write('function ');
                  write(def,'function ')
                end;
                { get last word }
                k := Length(Line[1]);
                while (k > 1) and not (Line[1,k] in [' ','*']) do Dec(k);
                { default = int }
                if (k = 1) and not (Line[1,1] in [' ','*']) then { int }
                begin
                  { skip, for now }
                end
                else
                  Inc(k);
                Name := '';
                repeat
                  Name := Name + UpCase(Line[1,k]);
                  write(Line[1,k]);
                  write(def,Line[1,k]);
                  Inc(trailing);
                  Inc(k)
                until k > Length(Line[1]);
                Dec(k);
                while (k > 1) and not (Line[1,k] in [' ','*']) do Dec(k);
                writeln(def);
                { default = int }
                if (k = 1) and not (Line[1,1] in [' ','*']) then { int }
                  Line[1] := 'int'
                else
                  Line[1,0] := Chr(k);
                SkipSpaces(Line[1]);
                { got last word }
                Upper(Line[1])
              end
            end
            else
            if (j = 2) and (i = 2) and
              ((Line[j] = 'void') or (Line[j] = 'VOID') or (Line[j,1] = ')')) then
            begin
              { no arguments }
            end
            else { argument list }
            begin
              if (j = 2) then
              begin
                inc(trailing);
                write('(')
              end
              else
              begin
                writeln;
                write(' ':trailing)
              end;
              FindConst(Line[j]);
              { get last word }
              k := Length(Line[j]);
              if (k >= 1) and (Line[j,1] <> '{') then
              begin
                if Line[j,k] = '*' then Dec(k); { 3.09 fix }
                while (k >= 1) and not (Line[j,k] in [' ','*']) do Dec(k);
                if (k <= 1) then { Marco Cantu }
                begin
                  System.Str(j-1:1,Number); { start with 1 }
                  write('_',Number)
                end
                else
                begin
                  Inc(k);
                  repeat
                    write(Line[j,k]);
                    Inc(k)
                  until k > Length(Line[j]);
                  Dec(k);
                  while (k > 1) and not (Line[j,k] in [' ','*']) do Dec(k);
                  Line[j,0] := Chr(k);
                  SkipSpaces(Line[j]);
                  { got last word }
                end;
                write(': ');
                Upper(Line[j]);
                { change ' *' into '* '
                repeat
                  com := Pos(' *',Line[j]);
                  if (com > 0) then
                  begin
                    Line[j,com] := '*';
                    Line[j,com+1] := ' '
                  end
                until com = 0;
                { changed ' *' into '* ' }
                SkipSpaces(Line[j]);
                SkipVoid(Line[j]);
                FindType(Line[j],False);
                if (j < i) then write('; ')
                           else write(')')
              end
              else
              begin
                writeln(')') { BUG I don't know why... }
              end
            end
          end;

          cdecl := True;
          for i:=1 to MaxVoid do
          begin
            repeat
              k:=Pos(Void[i],Line[1]);
              if (k > 0) and
                ((k = 1) or not (Line[1,k-1] in IdentSet)) and
                ((Length(Line[1]) <= (Length(Void[i])+k)) or
                 (Line[1,k+Length(Void[i])] in [' ','*',';',')'])) then
              begin
                cdecl := (i >= PasVoid) and cdecl;
                Delete(Line[1],k,Length(Void[i]));
                if (Line[1,k-1] = '_') then Delete(Line[1],k-1,1);
              { Line[1,0] := Chr(k-1); }
                SkipSpaces(Line[1]);
                while (Line[1,Length(Line[1])] = '*') and
                      (Line[1,Length(Line[1])-1] = ' ') do
                  Delete(Line[1],Length(Line[1])-1,1)
              end
              else k := 0
            until k = 0
          end;

          if (Pos('VOID',Line[1]) = 0) and (Pos('void',Line[1]) = 0) then
          begin { function type? }
            write(': ');
            FindType(Line[1],True)
          end
          else { 3.15 }
          begin
            Delete(Line[1],1,4);
            SkipSpaces(Line[1]);
            if not (Line[1,1] in IdentSet) then
            begin
              write(': ');
              Line[1] := 'VOID' + Line[1];
              FindType(Line[1],True)
            end
          end;
          if cdecl then write(' cdecl ') { remove ';' before cdecl };
          write(' {$IFDEF WIN32} stdcall {$ENDIF}');
          writeln('; '{; far;'})
        end
      end
    end
  end;
  if Explicit then
  begin
    writeln;
    writeln('var');
    writeln('  DLLLoaded: Boolean { is DLL (dynamically) loaded already? }');
    writeln('    {$IFDEF WIN32} = False; {$ENDIF}');
    writeln;
    writeln('implementation');
    writeln;
    writeln('var');
    writeln('  SaveExit: pointer;');
    writeln('  DLLHandle: THandle;');
    writeln('{$IFNDEF MSDOS}');
    writeln('  ErrorMode: Integer;');
    writeln('{$ENDIF}');
    writeln;
    writeln('  procedure NewExit; far;');
    writeln('  begin');
    writeln('    ExitProc := SaveExit;');
    writeln('    FreeLibrary(DLLHandle)');
    writeln('  end {NewExit};');
    writeln;
    writeln('procedure LoadDLL;');
    writeln('begin');
    writeln('  if DLLLoaded then Exit;');
    writeln('{$IFNDEF MSDOS}');
    writeln('  ErrorMode := SetErrorMode($8000{SEM_NoOpenFileErrorBox});');
    writeln('{$ENDIF}');
    writeln('  DLLHandle := LoadLibrary(''',DLL,'.DLL'');');
    writeln('  if DLLHandle >= 32 then');
    writeln('  begin');
    writeln('    DLLLoaded := True;');
    writeln('    SaveExit := ExitProc;');
    writeln('    ExitProc := @NewExit;');
    reset(def);
    while not eof(def) do
    begin
      readln(def,Str);
      if Len > 0 then
      begin
        write('@':5,Str);
      { Upper(Str); }
        writeln(' := GetProcAddress(DLLHandle,''',Str,''');');
        writeln('  {$IFDEF WIN32}');
        writeln('    Assert(@',Str,' <> nil);');
        writeln('  {$ENDIF}')
      end
    end;
    writeln('  end');
    writeln('  else');
    writeln('  begin');
    writeln('    DLLLoaded := False;');
    writeln('    { Error: ',DLL,'.DLL could not be loaded !! }');
    writeln('  end;');
    writeln('{$IFNDEF MSDOS}');
    writeln('  SetErrorMode(ErrorMode)');
    writeln('{$ENDIF}');
    writeln('end {LoadDLL};');
    writeln;
    writeln('begin');
    writeln('  LoadDLL;')
  end
  else
  begin
    writeln;
    writeln('implementation');
    writeln;
    reset(def);
    while not eof(def) do
    begin
      readln(def,Str);
      if Len > 0 then writeln(Str,'; external ''',DLL,'.DLL'';')
    end;
    writeln
  end;
  writeln('end.');
  if IOResult <> 0 then { skip };
  System.close(tmp);
  System.close(def);
  if IOResult <> 0 then { skip };
  Erase(def);
  Erase(tmp);
  if IOResult <> 0 then { skip };
  System.close(output);
  Assign(output,Dir+DLL+'.PAS');
  rewrite(output);
{ System.close(input); }
  Assign(input,Dir+DLL+'.~PA');
  Reset(input);
  j := 0; { lines read so far }
  Commentaar := '';
  InType := False;
  while not eof do
  begin
    Reset(input);
    for k:=1 to j do readln(Str);
    k := 0;
    while (k = 0) and not eof do
    begin
      readln(Str);
      Inc(j);
      if not Explicit and
        ((Pos('procedure ',Str) = 1) or
         (Pos('function ',Str) = 1)) then InType := False; { 3.24 }
      if (Pos(': P',Str) > 0) and (Pos('const ',Str) = 0) and
         (Pos(': PChar',Str) = 0) and
         (Pos(': Pointer',Str) = 0) and { 3.13 }
          not InType then
      begin
        i := Pos(': P',Str);
        Delete(Str,i+2,1);
        repeat
          Dec(i)
        until (i <= 1) or (Str[i-1] in [' ','(']);
        Insert('var ',Str,i)
      end;
      while Pos('+1-1]',Str) > 1 do Delete(Str,Pos('+1-1]',Str),4);
      if Pos('var ',Str) = 1 then
      begin
        InType := False;
        writeln('var');
        Delete(Str,1,3);
        Str := ' ' + Str
      end
      else
      if Pos('const ',Str) = 1 then
      begin
        InType := True;
        writeln('const');
        Delete(Str,1,5);
        Str := ' ' + Str
      end
      else
      if Pos('type ',Str) = 1 then
      begin
        InType := True;
        i := 0;
        if Pos('type _',Str) = 1 then
        begin
          i := 6;
          repeat
            Inc(i);
          until (i >= Len) or not (Str[i] in ['0'..'9']);
          Dec(i); { go to last valid character... }
          if i > Len then i := Len
        end;
        if (i > 0) and (Str[i] in ['0'..'9']) then
        begin
          if Commentaar <> '' then { replaced }
          begin
            Delete(Str,1,5);
            while (Len > 0) and (Str[1] <> ' ') do Delete(Str,1,1);
            SkipSpaces(Str);
            writeln('type'); { 3.19 }
            Str := '  '+Commentaar+' '+Str;
            Commentaar := ''
          end
          else
          begin
            k := j;
            Commentaar := '';
            while not eof and (Pos('end {',Commentaar) <> 1) do
            begin
              readln(Commentaar);
              SkipSpaces(Commentaar)
            end;
            if Pos('end {',Commentaar) = 1 then
            begin
              Delete(Commentaar,1,5);
              Delete(Commentaar,Pos('}',Commentaar),255)
            end;
            Dec(j); { 3.21 }
          { reset(input) { patch }
          end
        end
        else
        begin
          writeln('type');
          Delete(Str,1,4);
          SkipSpaces(Str);
          Str := '  '+Str
        end
      end;
      if k = 0 then writeln(Str)
    end
  end;
  close(input);
  erase(input);
  close(output)
end {HeadConvert};

end.