Delphi 调用 go dll

Pykill 写入

Delphi 调用 go dll

只需要用两个C.GoString   C.CString

我只是为自己写的一个http 调用，主要是go在调用非常稳定，不会存在证书，不证书，连接过多被报错，正常情况下的网络报错问题，在这里同时分享go的dll 和delphi 调用，里面有string ,bytes的多方便调用  这里只测试get， post 还没测试就跑来发布了

还要注意下，这里是以32编译的dll  

这下面是编译命令

set GOARCH=386

set CGO_ENABLED=1

go build -buildmode=c-shared -o Vhttp.dll main.go

 

go 的dll 代码

 

package main

import (
   "bytes"
   "encoding/json"
   "fmt"
   "github.com/tidwall/gjson"
   "github.com/zetamatta/go-windows-dbg"
   "golang.org/x/text/encoding/simplifiedchinese"
   "golang.org/x/text/encoding/unicode"
   "golang.org/x/text/transform"
   "io/ioutil"
   "net"
   "net/http"
   "sync"
   "time"
)
import "C"

var client =  http.Client{}

var syncpol  sync.Pool
func init()  {
//这里初始化连接客户端，非常稳定
   client = http.Client{Timeout: 5 * time.Second,
      Transport: &http.Transport{
         Proxy: http.ProxyFromEnvironment,
         DialContext: (&net.Dialer{
            Timeout:   1 * time.Second,
            KeepAlive: 30 * time.Second,
            DualStack: true,
         }).DialContext,
         MaxIdleConns:        100,
         MaxIdleConnsPerHost: 8,
         IdleConnTimeout:     120 * time.Second,
      }}
   syncpol = sync.Pool{}
   dbg.Println("init ok")

}
func main()  {

}

func Decode(s *C.char)string  {
    cs16 := C.GoString(s)
    //s8,_ := code16to8.String(cs16)
    return cs16
}

func Encode(s string)*C.char  {
    //s16,_ := code8to16.String(s)
   var kms  string
   ls  := syncpol.Get()
   if  ls == nil {
      kms = s
   } else {
      kms = ls.(string)
   }
   syncpol.Put(kms)
    return C.CString(s)
}

func writeerror(err string)string  {
    vs := map[string]interface{}{"error":err}
    buf,_ := json.Marshal(vs)
    return string(buf)

}
//这里的export 是必须要加上这是对外可见
//export SHChar
func SHChar(sh *C.char)*C.char  {
   dbg.Println(9,sh)
   return sh
}
//export SH1Char
func SH1Char(sh *C.char)*C.char{
   vms := Decode(sh)
   dbg.Println(3,vms )
   kms := "SH1Chia"

   //return C.CString(kms)
   return Encode(kms)
}

func vlog(s string)  {
   dbg.Println(s)
}

//export Httpurl
func Httpurl(styp int, url,sh , buf *C.char )*C.char  {
   var surl string
   var ssh  string
   var sbuf string
   if url != nil {
      surl = Decode(url)
   }
   if sh != nil {
      ssh = Decode(sh)
   }
   if buf != nil  {
      sbuf = Decode(buf)
   }
   if surl == "" {
      s := writeerror("url is emtpy")
      return Encode(s)
   }
   var req *http.Request
   var err error
   if sbuf != "" {
      sby:= bytes.NewBuffer([]byte(sbuf))
      req,err = http.NewRequest("GET",surl,sby)
      if err != nil {
         s := writeerror(err.Error())
         return Encode(s)
      }
   } else {
      req,err = http.NewRequest("GET",surl,nil)
      if err != nil {
         s := writeerror(err.Error())
         return Encode(s)
      }
   }
   if ssh != "" {
      sher := gjson.Get(ssh,"header")
      if sher.Exists() {
         for k, v := range sher.Map() {
            req.Header.Set(k, v.Value().(string))
         }
      }
   }
   
   switch styp {
   case 1: //get
       {
        req.Method = "GET"
      }
   case 2://post
       {
       req.Method = "POST"
      }
   case 3://head
      {
      req.Method = "HEAD"
      }
   case 4:
      {
      req.Method = "PUT"
      }
   case 5:
      {
      req.Method = "DELETE"
      }
   case 6:
      {
      req.Method = "OPTIONS"
      }
   case 7:
      {
       req.Method = "TRACE"
      }
   case 8:
      {
      req.Method = "PATCH"
      }
   default:
      {
       return Encode("stype is error")
      }
   }
   reqs,err := client.Do(req)
   if err != nil {
      return Encode(err.Error())
   }
   smap := map[string]interface{}{}
   vbuf,err := json.Marshal(reqs.Header)
   if err != nil {
      return Encode(err.Error())
   }
   smap["header"] = string(vbuf)
   vbuf ,err = ioutil.ReadAll(reqs.Body)
   if err != nil {
      return Encode(err.Error())
   }
   var sss string
   for _, v := range vbuf{
      sss += fmt.Sprintf(" %d", v)
   }

   smap["data"] = sss

    kbuf,_ := json.Marshal(smap)
    return Encode(string(kbuf))
}

这里是delphi 代码

dll 接口代码

unit VHTTP;

interface

uses
  Winapi.Windows, system.Classes, system.SyncObjs, system.Types, System.SysUtils;

type

  TVHTTPDLL = Class
  private
    Mydll: HMODULE;
    FError: string;
    Finit: Boolean;
    procedure SetError(const Value: string);
  protected
    procedure init;
  public

    constructor Create;
    destructor Destroy; override;
    property Error: string read FError write SetError;
    function CSHChar(s: PAnsiChar): PAnsiChar;
    function CSH1Char(s: PAnsiChar): PAnsiChar;
    function CHttpurl(stype: Integer; url, header, buf: PAnsiChar): PAnsiChar;
  End;

const
  Vhttpdllname = 'Vhttp32.dll';

implementation

{ TVHTTPDLL }
var
  SHChar: function(s: PAnsiChar): PAnsiChar; cdecl;
  SH1Char: function(s: PAnsiChar): PAnsiChar; cdecl;
  Httpurl: function(stype: Integer; url, header, buf: PAnsiChar): PAnsiChar; cdecl;

function TVHTTPDLL.CHttpurl(stype: Integer; url, header, buf: PAnsiChar): PAnsiChar;
begin
  Result := Httpurl(stype, url, header, buf)
end;

constructor TVHTTPDLL.Create;
begin
  Self.init;
end;

function TVHTTPDLL.CSH1Char(s: PAnsiChar): PAnsiChar;
begin
  Result := SH1Char(s);
end;

function TVHTTPDLL.CSHChar(s: PAnsiChar): PAnsiChar;
begin
  Result := SHChar(s);
end;

destructor TVHTTPDLL.Destroy;
begin
  if Finit then
  begin

    freeLibrary(Mydll);
  end;

end;

procedure TVHTTPDLL.init;
begin
  FError := '';
  Mydll := LoadLibrary(Vhttpdllname);
  if Mydll <> 0 then
  begin
    @SHChar := GetProcAddress(Mydll, 'SHChar');
    @SH1Char := GetProcAddress(Mydll, 'SH1Char');
    @Httpurl := GetProcAddress(Mydll, 'Httpurl');
    if not Assigned(SHChar) and not Assigned(SH1Char) and not Assigned(Httpurl) then
    begin
     raise Exception.Create('init Vhttp error');
     Exit;
    end;

    Finit := True;

    Exit;
  end;
  FError := 'loadlibrayf error';
  Exit;
end;

procedure TVHTTPDLL.SetError(const Value: string);
begin
  FError := Value;
end;

end.

窗口代码

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Buttons, VHTTP, Vcl.StdCtrls, qjson;

type
  TForm1 = class(TForm)
    SpeedButton1: TSpeedButton;
    mo1: TMemo;
    SpeedButton2: TSpeedButton;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
  private
    { Private declarations }
    FVhttp: TVHTTPDLL;
    procedure Log(s: string);
  public
    { Public declarations }

  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  FVhttp := TVHTTPDLL.Create;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  FVhttp.Free;
end;

procedure TForm1.Log(s: string);
var
  vs: string;
begin
  vs := FormatDateTime('dd hh:nn:ss', Now) + s;
  mo1.Lines.Insert(0, vs);
end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
  Log(FVhttp.CSHChar(PAnsiChar('delphi')));
  Log(FVhttp.CSH1Char(PAnsiChar('delphi1')));
end;

function VToByte(s: string): TBytes;
var
  sts: TStringList;
  i: integer;
begin
  sts := TStringList.Create;
  try
    sts.Delimiter := ' ';
    sts.DelimitedText := s;
    SetLength(result, sts.Count);
    for i := 0 to sts.Count - 1 do
    begin
      result[i] := strtoint(sts[i]);
    end;

  finally
    sts.Free;
  end;

end;

 

procedure TForm1.SpeedButton2Click(Sender: TObject);
var
  url, header, sbuf: PAnsiChar;
  vds, vhex, sutf8: string;
  tjs: TQjson;
  vbuf: TBytes;
  sts: TStringStream;
begin
  url := 'http://time.tianqi.com/';

  vds := FVhttp.CHttpurl(1, url, '', '');
  tjs := TQjson.Create;
  try
    tjs.Parse(vds);
    vhex := tjs.ForceName('data').AsString;
    if vhex <> '' then
    begin
      vbuf := VToByte(vhex);
      sts := TStringStream.Create('', TEncoding.UTF8);
      try
        sts.Write(vbuf, 0, length(vbuf));
        Log(sts.DataString);

      finally
        sts.Free;
      end;

    end;

  finally
    tjs.Free;
  end;
end;

end.