关于使用apache PHP作中间层Delphi接口程序3

3. Delphi  使用接口

FIDHttp:TIdHTTP;

const FBaseURL:string＝'apache 服务器地址';

procedure TWisePHPClient.ConnectSvr(Facc，FPwd：string);
begin
  FIDHttp.Request.Clear;
  FIDHttp.Request.BasicAuthentication:=True;
  FIDHttp.Request.Username:=Facc;
  FIDHttp.Request.Password:=FPwd;
end;

function TWisePHPClient.ExecultRestMethodByPHP(functionname:string;params:TJSONObject):TStringStream;
var RequestList : TStrings;
    ress:TStringStream;
begin
  FIDHttp.Request.ContentType:='text/html';
  RequestList:=TStringList.Create;
  if functionname<>'' then
    RequestList.Add('functionname='+functionname);
  if params<>nil then
    RequestList.Add('params='+TNetEncoding.Base64.Encode(params.ToJSON));
  ress := TStringStream.Create('',TEncoding.UTF8);

  FIDHttp.post(FBaseURL+'phpapi.php',RequestList,ress);

  if FIDHttp.ResponseCode<>200 then Sys.Dialogs.ShowError('連接服務器PHP API意外出錯')
  else begin
    Result:=ress;//TStringStream.Create(ress.DataString,TEncoding.UTF8);
  end;
  RequestList.Free;
end;

function GetDelphiFieldTypeFromPDO(pdofield:string):TFieldType;
var rjs,tmp:string;  //Reference Json string
    m,n,s:Integer;
begin
  rjs:='"int":3,"nvarchar":24,"binary":12,"bit":5,"char":1,'+
         '"date":9,"datetime":11,"datetime2":36,"datetimeoffset":36,'+
         '"decimal":37,"float":6,"geography":15,"geometry":15,'+
         '"udt":15,"image":15,"money":7,"nchar":24,'+
         '"ntext":39,"numeric":37,"real":51,"smalldatetime":11,'+
         '"smallint":2,"smallmoney":7,"sql_variant":24,"text":16,'+
         '"time":10,"timestamp":36,"tinyint":44,"uniqueidentifier":35,'+
         '"varbinary":13,"varchar":1,"xml":20,"bigint":25,'+
        '"LONGLONG":25,"STRING":1,"BIT":5,'+
        '"BLOB":1,"TINY":43,'+
        '"DATE":9,"DATETIME":11,'+
        '"NEWDECIMAL":8,"DOUBLE":6,"FLOAT":6,'+
        '"LONG":3,"INT24":3,"SHORT":2,"TIME":10,'+
        '"TIMESTAMP":36,"VAR_STRING":1,"YEAR":4';
  tmp:='"'+pdofield+'"';
  m:=Pos(tmp,rjs);
  s:=m+Length(tmp)+1;
  tmp:=Copy(rjs,s,2);
  if tmp[2]=',' then tmp:=Copy(tmp,1,1);
  n:=StrToIntDef(tmp,1);
  result:=TFieldType(n);
end;

procedure TWisePHPClient.GetDBSqlDataFromPHP(sql: string; DBName: string;IQry:TFDMemTable);
var pam:TJSONObject;
    jfields,jDataSet: TJSONArray;
    alldd: TJSONObject;
    i,j,w: Integer;
    ress,fdn,fdt,fdv:string;
    fdtt:TFieldType;
begin
  pam:=TJSONObject.Create;
  try
    pam.AddPair('dbname',DBName);
    pam.AddPair('sqlstr',sql);
    IQry.Active:=False;
    ress:=ExecultRestMethodByPHP('db_querytojson',pam).DataString;
    if ress<>'' then begin
      alldd:=TJSONObject.Create.ParseJSONValue(ress) as TJSONObject;
      jfields:=alldd.GetValue('field_data') as TJSONArray;
      jDataSet:=alldd.GetValue('row_data') as TJSONArray;
      IQry.FieldDefs.Clear;
      for I := 0 to jfields.size-1 do begin
        fdn:=TJSONObject(jfields.Get(i)).GetValue('fieldname').value;
        fdt:=TJSONObject(jfields.Get(i)).GetValue('fieldtype').Value;
        w:=StrToIntDef(TJSONObject(jfields.Get(i)).GetValue('len').Value,0);
        fdtt:=GetDelphiFieldTypeFromPDO(fdt);
        try
          IQry.FieldDefs.Add(fdn,fdtt,w);
        except
          IQry.FieldDefs.Add(fdn,fdtt,0);
        end;
      end;
      IQry.CreateDataSet;
      IQry.CachedUpdates:=True;
      for i := 0 to jDataSet.Size - 1 do  begin
        IQry.Append;
        for j := 0 to TJSONObject(jDataSet.Get(i)).Count - 1 do begin
          fdn:=TJSONObject(jDataSet.Get(i)).Pairs[j].JsonString.Value;
          fdv:=TJSONObject(jDataSet.Get(i)).Pairs[j].JsonValue.Value;
          try
            if fdv='null' then fdv:='' else
            if IQry.Fields[j].DataType in [ftDate, ftTime, ftDateTime] then
              IQry.Fields[j].Value:=StrToDateTime(fdv)
            else IQry.Fields[j].Value :=fdv ;
          except
            IQry.Fields[j].Value :=null ;
          end;
        end;
        IQry.Post;
      end;
    end;
  finally
    pam.Free;
    alldd.Free;
    IQry.Active:=True;
    IQry.First;
  end;
end;

function TWisePHPClient.HttpDownLoadFile(svrfile,tofile:string):Boolean;
var MyMemoryStream: TMemoryStream;
    downloadUrl,topath,lwfn,tmp: string;
begin

  lwfn:=Trim(LowerCase(svrfile));
  if (lwfn='') or (lwfn='*') then exit;
  downloadUrl:=FBaseURL+'phpapi.php?dl='+httpencode(svrfile);
  MyMemoryStream := TMemoryStream.Create;
  FIDHttp.Get(downloadUrl, MyMemoryStream);
  result:=FIDHttp.ResponseCode=200;
  if not result then Sys.Dialogs.ShowError('下載文件('+downloadUrl+')意外出錯')
  else begin
    if Pos('Error,File not found',FIDHttp.ResponseText)>0 then
      Sys.Dialogs.ShowError('文件('+downloadUrl+')沒找到,'+FIDHttp.ResponseText)
    else begin
      MyMemoryStream.SaveToFile(tofile);
    end;
  end;
end;

function TWisePHPClient.HttpUploadFile(localfile,tosvrpath:string):Boolean;
var postStream : TIdMultiPartFormDataStream;
    baseurl,ress:string;
begin
  postStream := TIdMultiPartFormDataStream.Create;
  postStream.AddFormField('uploadtopath', tosvrpath); // 表单参数
  postStream.AddFile('wisefile', localfile); // 表单文件
  FIDHttp.Request.ContentType:='multipart/form-data';
  baseurl:=FBaseURL+'phpapi.php';
  ress:=FIDHttp.Post(baseurl,postStream);
  result:=FIDHttp.ResponseCode=200;
  if not result then
    Sys.Dialogs.ShowError('上傳文件('+localfile+')意外出錯:'+ress)
  else begin
    if Pos('Error',ress)>0 then
      Sys.Dialogs.ShowError('上傳文件('+localfile+')文件失敗:'+ress);
  end;
  postStream.Free;
end;

function TWisePHPClient.ExecSql(Sqlstr: string; DBName: string): integer;
var pam:TJSONObject;
begin
   pam:=TJSONObject.Create;
  try
    pam.AddPair('dbname',DBName);
    pam.AddPair('sqlstr',Sqlstr);
    Result:=strtointdef(ExecultRestMethodByPHP('db_execsql',pam).DataString,0);
  finally
    pam.Free;
  end;
end;

function TWisePHPClient.BathExecuteSqls(sqls:TStrings; DBName: string):Integer;
var i:Integer;
    ssql,rss:string;
    pam:TJSONObject;
begin
  for I := 0 to sqls.count-1 do
    if ssql='' then ssql:=sqls.strings[i]
    else ssql:=ssql+'|'+sqls.strings[i];
  pam:=TJSONObject.Create;
  try
    pam.AddPair('dbname',DBName);
    pam.AddPair('sqlstr',ssql);
    rss:=ExecultRestMethodByPHP('db_batchexecsql',pam).DataString;
    result:=strtointdef(rss,0);
  finally
    pam.Free;
  end;
end;

procedure TWisePHPClient.MyQuery(IQry: TFDMemTable; ISqlStr: string;DBname:string);
begin
  GetDBSqlDataFromPHP(ISqlStr,DBname,IQry);
end;