| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787 | {*******************************************************************************    单元名称: PHPWebDm.pas    单元说明: Delphi 同PHP web服务器通信接口。 计量的PHP比造价的PHP多了很多    作者时间: Chenshilong, 2012-5-13*******************************************************************************}unit PHPWebDm;interfaceuses  SysUtils, Classes, IdBaseComponent, IdComponent, IdTCPConnection,  IdTCPClient, IdHTTP, CslJson;type  // Web连接成功、Web连接失败、登录失败、旧用户需要升级、资料不全  TLoginType = (ltCon, ltDisCon, ltLoginFail, ltUpdate, ltIncomplete);  TPHPWeb = class(TDataModule)    procedure DataModuleCreate(Sender: TObject);  private    // 远程服务器上时间    FServerDateTime: TDateTime;    FUserID: Integer;    FAccount: string;    FRealName: string;    FUserFlag: Integer; // 用户标志位,用于区分出一部分用户进行特殊控制。    FMeasureURL: string;  // http://d.jl.smartcost.com.cn/api/client/    FLoginURL: string;    FLoginBannerURL: string;    FCheckOnLineURL: string;    FPassportURL: string;    FPwdURL: string;    FRegURL: string;    FWebLoginURL: string;    FServerDateTimeURL: string;    FWebSoftURL: string;    FLogoutURL: string;    FRole: string;    FCompany: string;    FUserImageURL: string;    FLoginCloudURL: string;    procedure SetUserID(const Value: Integer);    procedure SetAccount(const Value: string);    procedure SetRealName(const Value: string);{-------------------------------------------------------------------------------  方法:   CustomSearch()  描述:   通用的查询接口,集各种复杂情况之大成,宇宙级牛B综合算法,哦耶! ^__^          【函数返回值】            -1:           网络不通;             0:           网络通,但登录或查询出错、网页出错等,无法返回约定的                           Json格式,通常返回一篇乱码;             1:           成功(包括返回零记录)          【参数】             AURL:        请求的网址。             AInFields:   请求的键名字。             AInValues:   请求的键值。             AResultType: 返回值类型:0 返回一维数组;1 返回二维数组;2 两者都。             AOutStrs:    用于存储返回的零散值。需要赋字段名传入。             AOutRecords: 用于存储返回的多条记录、数据表。只需声明,无需定义大                           小和赋值,返回Json的数组,数组的值为'info'对象的值。          【要求】             ①返回的Json数据中必须有status、msg两个键名字(约定格式)。             ②AResults至少有一个元素,用来存储当返回值为0时查询出错的原因。  作者:   Chenshilong, 2014-07-13-------------------------------------------------------------------------------}    function CustomSearch(AURL: string; AInFields, AInValues: array of string;      AResultType: Integer; var AOutStrs: array of string;      var AOutRecords: TOVArr): Integer;  public    function SystemDateTime: TDateTime;    function Search(AURL: string; AInFields, AInValues: array of string; var AOutStrs: array of string): Integer; overload;    function Search(AURL: string; AInFields, AInValues: array of string; var AOutRecords: TOVArr): Integer; overload;    function Search(AURL: string; AInFields, AInValues: array of string; var AOutStrs: array of string ; var AOutRecords: TOVArr): Integer; overload;    function Search(AURL: string; AInFields, AInValues: array of string; AResultType: Integer; var AOutStrs: array of string ; var AOutRecords: TOVArr): Integer; overload;    // ALoginType, 登录类型,1 正常情况下的用户名密码;2 紫光平台调用仅用户名无密码    function Login(AAccount, APW: string; ALoginType: Integer; var AInfo, ANewExeURL: string): TLoginType;    function ConnectServer(AIP: string; var ACompanyName: string): Integer;  // 新装软件,先弹出设置IP窗口    function UpDataFile(AUserID, ATenderID, APhaseNo: Integer; AFile, AMD5_JL: string;      AIsSubmit: Boolean; var AResultStr: string; ACheckPassed: Boolean; ACheckerMemo: string): Boolean;    function UpAttachment(AUperID, AWebID, ABillID, APhase: Integer; AFile, ACategory, AMemo: string; var ANewFileName, AFileID, ADownURL: string): Boolean;    function UpAttachmentOnLine(AWebID, ABillID, APhase: Integer; AIDAry: array of  string): Boolean;    function DeleteAttachment(AFileID: Integer): Integer;    function GetAttachmentList(AWebID: Integer; var vArr: TOVArr): Boolean;    function zip(AFileArr: array of string): string;    function CheckZip(AZipFile: string; AFileCount: Integer): Boolean;   // 检测zip是否能够正确解压出所有文件。    function TempName(ALength: Integer = 12): string;    function WebPath: string;    function UserPath: string;    // 下载文件:源文件网址;存储到本地的位置    function DownFile(ASourceURL: string; var ALocalFile: string): Boolean;    // 用于调试输出值,解决灵异现象(有些现象调试环境正常,运行环境时有时无)    procedure Debug(AFileName, AStr: string); overload;    procedure Debug(AFileName: string; AInFields, AInValues: array of string); overload;    function NetError(AMid: string): string;    function PageError(AMid: string): string;    function ExistInServer(AWebID: Integer): Boolean;    function GetNameFromURLProtocol(AURLProtocol: string): string;    property Account: string read FAccount write SetAccount;    property UserID: Integer read FUserID write SetUserID;    property RealName: string read FRealName write SetRealName;    property UserFlag: Integer read FUserFlag write FUserFlag;    property Company: string read FCompany write FCompany;    property Role: string read FRole write FRole;    property MeasureURL: string read FMeasureURL;    property WebSoftURL: string read FWebSoftURL;    property PassportURL: string read FPassportURL;    property LoginURL: string read FLoginURL;    property WebLoginURL: string read FWebLoginURL;    property LoginBannerURL: string read FLoginBannerURL;    property LogoutURL: string read FLogoutURL;    property RegURL: string read FRegURL;    property PwdURL: string read FPwdURL;    property CheckOnLineURL: string read FCheckOnLineURL;    property ServerDateTimeURL: string read FServerDateTimeURL;    property UserImageURL: string read FUserImageURL write FUserImageURL;    property LoginCloudURL: string read FLoginCloudURL write FLoginCloudURL;  end;function PHPWeb: TPHPWeb;// 全国  广东  标后预算 定额排版  港口水工  内河航运  疏浚 清单编制function ExeCategoryName: string;implementationuses  MD5Unit, IdMultipartFormData, VCLUnZip, VCLZip,  IniFiles, Forms, UtilMethods, Variants, ConstUnit, ScUtils;{, Controls, Windows}var g_PHPWeb: TPHPWeb;{$R *.dfm}{ TPHPWeb }function PHPWeb: TPHPWeb;begin  if g_PHPWeb = nil then    g_PHPWeb := TPHPWeb.Create(nil);  Result := g_PHPWeb;end;function ExeCategoryName: string;begin  Result := 'JLZF';end;function TPHPWeb.Login(AAccount, APW: string; ALoginType: Integer; var AInfo, ANewExeURL: string): TLoginType;var vArr: array of string;begin  vArr := VarArrayOf(['uid', 'name', 'email', 'ucompany', 'jobtitle', 'avatar', 'msg']);  case Search(FMeasureURL + 'signin', ['v4name', 'v4pass', 'version', 'logintype'],    [AnsiToUtf8(AAccount), APW, GetVersion{'0.0.0.0'}, IntToStr(ALoginType)], vArr) of    -1: Result := ltDisCon;    0:    begin      AInfo := vArr[0];      Result := ltLoginFail;    end;    1:    begin      FUserID := StrToInt(vArr[0]);      FRealName := vArr[1];      FAccount := AAccount;  // vArr[2]      FCompany := vArr[3];      FRole := vArr[4];      FUserImageURL := vArr[5];      AInfo := vArr[6];      Result := ltCon;    end;    2:    begin      AInfo := vArr[0];      ANewExeURL := vArr[1];      Result := ltUpdate;    end;  end;end;procedure TPHPWeb.SetUserID(const Value: Integer);begin  FUserID := Value;end;procedure TPHPWeb.SetAccount(const Value: string);begin  FAccount := Value;end;procedure TPHPWeb.DataModuleCreate(Sender: TObject);var ini: TIniFile;begin  FServerDateTime := -1;  ini := TIniFile.Create(ExtractFilePath(Application.ExeName) + 'Cloud.ini');  try//    FMeasureURL := ini.ReadString('URL', 'MeasureURL', '');    FMeasureURL := 'http://' + ini.ReadString('URL', 'Server', '') +      ini.ReadString('URL', 'MeasureURL', '');    FWebSoftURL := ini.ReadString('URL', 'WebSoftURL', '');    FPassportURL := ini.ReadString('URL', 'PassportURL', '');    FLoginCloudURL := ini.ReadString('URL', 'LoginCloudURL', '');    FLoginURL := FWebSoftURL + ini.ReadString('URL', 'LoginURL', '');    FWebLoginURL := FWebSoftURL + ini.ReadString('URL', 'FWebLoginURL', '');    FLoginBannerURL := FWebSoftURL + ini.ReadString('URL', 'LoginBannerURL', '');    FLogoutURL := FWebSoftURL + ini.ReadString('URL', 'LogoutURL', '');    FRegURL := FPassportURL + ini.ReadString('URL', 'RegURL', '');    FPwdURL := FPassportURL + ini.ReadString('URL', 'PwdURL', '');    FCheckOnLineURL := FWebSoftURL + ini.ReadString('URL', 'CheckOnLineURL', '');    FServerDateTimeURL := FWebSoftURL + ini.ReadString('URL', 'ServerDateTimeURL', '');  finally    ini.Free;  end;end;procedure TPHPWeb.SetRealName(const Value: string);begin  FRealName := Value;end;function TPHPWeb.zip(AFileArr: array of string): string;var vZip: TVCLZip;  sAppFile, sZipFile: string;  i: Integer;begin  Result := 'Error';  sAppFile := AFileArr[Low(AFileArr)];  sZipFile := ExtractFilePath(sAppFile) + ExtractFileNameWithoutExt(sAppFile) + '.up';  if FileExists(sZipFile) then      DeleteFile(sZipFile);  vZip := TVCLZip.Create(nil);  try    for i := Low(AFileArr) to High(AFileArr) do    begin      if FileExists(AFileArr[i]) then        vZip.FilesList.Add(AFileArr[i]);    end;    vZip.ZipName := sZipFile;    // PHP不支持解压加密zip文件    //vZip.Password := 'jlzf.Sc.2014';    vZip.Recurse := True;    vZip.ZipComment := '纵横计量支付';    vZip.OverwriteMode := Always;    vZip.Zip;    Result := sZipFile;    for i := Low(AFileArr) to High(AFileArr) do      DeleteFile(AFileArr[i]);  finally    vZip.Free;  end;end;function TPHPWeb.CheckZip(AZipFile: string; AFileCount: Integer): Boolean;var vUnZip: TVCLUnZip;begin  vUnZip := TVCLUnZip.Create(nil);  try    vUnZip.ZipName := AZipFile;    vUnZip.DestDir := 'C:\Temp\MeasureTemp\';    vUnZip.DoAll := True;    vUnZip.RecreateDirs := True;    vUnZip.RetainAttributes := True;    vUnZip.OverwriteMode := Always;    Result := (AFileCount = vUnZip.UnZip);  finally    DeleteFolder(vUnZip.DestDir);    vUnZip.Free;  end;end;function TPHPWeb.UpDataFile(AUserID, ATenderID, APhaseNo: Integer; AFile, AMD5_JL: string;  AIsSubmit: Boolean; var AResultStr: string; ACheckPassed: Boolean; ACheckerMemo: string): Boolean;var  IdDataStream: TIdMultiPartFormDataStream;  sResult, sURL: string;  J: TCslJson;  sZipMD5: string;  vIdHttp: TIdHTTP;begin  Result := False;  if not FileExists(AFile) then Exit;  IdDataStream := TIdMultiPartFormDataStream.Create;  vIdHTTP := TIdHTTP.Create(nil);  try    if ACheckPassed then   // 审核通过    begin      if AIsSubmit then      begin        sURL := Format('%speriod/%d/%d/%d/creat', [FMeasureURL, AUserID, ATenderID, APhaseNo])      end      else      begin        sURL := FMeasureURL + 'user/audit/measure';        IdDataStream.AddFormField('userid', IntToStr(AUserID));        IdDataStream.AddFormField('tenderid', IntToStr(ATenderID));        IdDataStream.AddFormField('phaseno', IntToStr(APhaseNo));        IdDataStream.AddFormField('CheckerMemo', ReplaceCharsForJson(ACheckerMemo));      end;    end    else  // 审核不通过    begin      sURL := Format('%suser/set/%d/%d/%d/checkno', [FMeasureURL, AUserID, ATenderID, APhaseNo]);      IdDataStream.AddFormField('CheckerMemo', ReplaceCharsForJson(ACheckerMemo));    end;    IdDataStream.AddFile('upfile', AFile, 'text/plain');    IdDataStream.AddFormField('upfile', AFile);    IdDataStream.AddFormField('MD5_JL', AMD5_JL);    sZipMD5 := MD5_File(AFile);    IdDataStream.AddFormField('MD5_Zip', sZipMD5);    IdDataStream.Position := 0;    try      sResult := vIdHTTP.Post(sURL, IdDataStream);    except      Abort;    end;  finally    IdDataStream.Free;    vIdHttp.Free;    DeleteFile(AFile);  end;  J := TCslJson.Create;  try    J.Text := Utf8ToAnsi(sResult);    if SameText(J.Value['status'], 'true') then      Result := True    else    begin      Result := False;      AResultStr := J.Value['msg'];    end;  finally    J.Free;  end;end;function TPHPWeb.Search(AURL: string; AInFields, AInValues: array of string; var AOutStrs: array of string): Integer;var vA: TOVArr;begin  Result := CustomSearch(AURL, AInFields, AInValues, 0, AOutStrs, vA);end;function TPHPWeb.Search(AURL: string; AInFields, AInValues: array of string; var AOutRecords: TOVArr): Integer;var vA: array of string;begin  Result := CustomSearch(AURL, AInFields, AInValues, 1, vA, AOutRecords);end;function TPHPWeb.Search(AURL: string; AInFields, AInValues: array of string; var AOutStrs: array of string; var AOutRecords: TOVArr): Integer;begin  Result := CustomSearch(AURL, AInFields, AInValues, 2, AOutStrs, AOutRecords);end;function TPHPWeb.Search(AURL: string; AInFields, AInValues: array of string; AResultType: Integer; var AOutStrs: array of string; var AOutRecords: TOVArr): Integer;begin  Result := CustomSearch(AURL, AInFields, AInValues, 3, AOutStrs, AOutRecords);end;function TPHPWeb.TempName(ALength: Integer): string;const  CodedBuf: array[0..35] of Char = ('0', '1', '2', '3', '4', '5',  '6', '7', '8', '9', 'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H', 'I',  'J', 'K', 'L', 'M', 'N', 'O', 'P', 'Q', 'R', 'S', 'T', 'U', 'V',  'W', 'X', 'Y', 'Z');begin  Result := '';  Randomize;  while Length(Result) < ALength do    Result := Result + CodedBuf[Random(36)];end;function TPHPWeb.WebPath: string;begin  Result := ExtractFilePath(Application.ExeName) + 'Web\';  if not DirectoryExists(Result) then    ForceDirectories(Result);end;function TPHPWeb.UserPath: string;begin  Result := ExtractFilePath(Application.ExeName) + 'Web\Users\' + IntToStr(FUserID) + '\';  if not DirectoryExists(Result) then    ForceDirectories(Result);end;function TPHPWeb.DownFile(ASourceURL: string; var ALocalFile: string): Boolean;var  vStream: TMemoryStream;  iFlag: Integer;  bOK: Boolean;  vIdHTTP: TIdHTTP;  procedure SafeDownFile(ASourceURL: string; var ALocalFile: string);  begin    Inc(iFlag);    bOK := False;    try      vIdHTTP.Get(ASourceURL, vStream);      vStream.SaveToFile(ALocalFile);      bOK := True;    except      bOK := False;    end;  end;begin  iFlag := 0;  bOK := False;  Result := False;  if Trim(ASourceURL) = '' then Exit;  if Trim(ALocalFile) = '' then Exit;  if (ExtractFileExt(ALocalFile) = '.rmf') and FileExists(ALocalFile) then    DeleteFile(ALocalFile);  vStream := TMemoryStream.Create;  vIdHTTP := TIdHTTP.Create(nil);  try    while (not bOK) and (iFlag < 3) do   // 尝试3次      SafeDownFile(ASourceURL, ALocalFile);    Result := bOK;  finally    vStream.Free;    vIdHTTP.Free;  end;end;function TPHPWeb.CustomSearch(AURL: string; AInFields,  AInValues: array of string; AResultType: Integer;  var AOutStrs: array of string; var AOutRecords: TOVArr): Integer;var  i: Integer;  postList: TStrings;  ssResponse: TStringStream;  bDone: Boolean;  vJson: TCslJson;  vIdHTTP: TIdHTTP;begin  Result := -1;  postList := TStringList.Create;  ssResponse := TStringStream.Create('');  vIdHTTP := TIdHTTP.Create(nil);  try    try      for i := Low(AInFields) to High(AInFields) do        postList.Add(Format('%s=%s', [AInFields[i], AInValues[i]]));      vIdHTTP.Post(AURL, postList, ssResponse);      bDone := True;    except      bDone := False;    end;    if (bDone) and (Pos('200 OK', vIdHTTP.ResponseText) <> 0) then   // 网络已通    begin      vJson := TCslJson.Create;      try        vJson.Text := Utf8ToAnsi(ssResponse.DataString);        if SameText(vJson.Value['status'], 'true') then          // 数据读取成功        begin          case AResultType of            0:            begin              for i := Low(AOutStrs) to High(AOutStrs) do                AOutStrs[i] := vJson.Value[AOutStrs[i]];            end;            1:            begin              AOutRecords := vJson.ArrayValues('info');            end;            2:            begin              for i := Low(AOutStrs) to High(AOutStrs) do                AOutStrs[i] := vJson.Value[AOutStrs[i]];              AOutRecords := vJson.ArrayValues('info');            end;            3:            begin              vJson.ChildValues('info', AOutStrs);              AOutRecords := vJson.ArrayValues('auditinfo');            end;          end;          Result := 1;        end        else if SameText(vJson.Value['status'], 'false') then                                                    // 数据读取失败        begin          case AResultType of            0:            begin              AOutStrs[Low(AOutStrs)] := vJson.Value['msg'];            end;            1:            begin              SetLength(AOutRecords, 1, 1);              AOutRecords[0, 0] := vJson.Value['msg'];            end;            2, 3:            begin              AOutStrs[Low(AOutStrs)] := vJson.Value['msg'];              SetLength(AOutRecords, 1, 1);              AOutRecords[0, 0] := vJson.Value['msg'];            end;          end;          Result := 0;        end        else if SameText(vJson.Value['status'], 'upgrade') then        begin          AOutStrs[Low(AOutStrs)] := vJson.Value['msg'];          AOutStrs[Low(AOutStrs) + 1] := vJson.Value['url'];          Result := 2;        end;      finally        vJson.Free;      end;    end;  finally    postList.Free;    ssResponse.Free;    vIdHTTP.Free;  end;end;function TPHPWeb.SystemDateTime: TDateTime;begin  Result := Now;end;function TPHPWeb.NetError(AMid: string): string;begin  Result := Format('当前网络状态较差(-1),%s,请重新尝试或重新登录后再尝试!', [AMid]);end;function TPHPWeb.PageError(AMid: string): string;begin  Result := Format('Web页返回错误(000J),%s,请重新尝试或联系纵横客服。', [AMid]);end;procedure TPHPWeb.Debug(AFileName, AStr: string);var vSL: TStringList;  sAdd: string;begin  vSL := TStringList.Create;  try    sAdd := Format('%s%d %s %s', [#10#13#10#13#10#13#10#13#10#13,      UserID, RealName, Account]);    vSL.Add(AStr + sAdd);    if Pos('Debug_', AFileName) = 0 then      AFileName := 'Debug_' + AFileName;    vSL.SaveToFile(WebPath + AFileName + '.txt');  finally    vSL.Free;  end;end;procedure TPHPWeb.Debug(AFileName: string; AInFields, AInValues: array of string);var vSL: TStringList;  sAdd: string;  i: Integer;begin  if G_IsTest then  begin    vSL := TStringList.Create;    try      sAdd := Format('%s%d  %s  %s', [#10#13#10#13#10#13#10#13#10#13, UserID, RealName, Account]);      for i := Low(AInFields) to High(AInFields) do        vSL.Add(AInFields[i] + #9#9 + AInValues[i]);      vSL.Add(sAdd);      if Pos('Debug_', AFileName) = 0 then        AFileName := 'Debug_' + AFileName;      vSL.SaveToFile(WebPath + AFileName + '.txt');    finally      vSL.Free;    end;  end;end;function TPHPWeb.ConnectServer(AIP: string; var ACompanyName: string): Integer;var vArr: array of string;  sURL: string;begin  sURL := Format('http://%s/api/client/software/title', [AIP]);  vArr := VarArrayOf(['msg']);  Result := Search(sURL, [], [], vArr);  case Result of    -1: ACompanyName := '地址不存在';    0: ACompanyName := '服务器Web页错误';    1: ACompanyName := vArr[0];  end;end;function TPHPWeb.UpAttachment(AUperID, AWebID, ABillID, APhase: Integer; AFile,  ACategory, AMemo: string; var ANewFileName, AFileID, ADownURL: string): Boolean;var  vMPFDS: TIdMultiPartFormDataStream;  sResult, sURL: string;  J: TCslJson;  vArr: array of string;  vIdHTTP: TIdHTTP;begin  Result := False;  if not FileExists(AFile) then  begin//    Application.MessageBox(PChar(AFile + ' 文件不存在!'), '错误', MB_OK + MB_ICONERROR);    Exit;  end;  vMPFDS := TIdMultiPartFormDataStream.Create;  vIdHTTP := TIdHTTP.Create(nil);  try    sURL := Format('%stender/attachment/%d/%d/upload', [FMeasureURL, AWebID, AUperID]);    // 如果文件已被打开,这里会报错。    try      vMPFDS.AddFile('upitem', AFile, 'text/plain');    except      MessageHint(0, '当前文件处于打开状态,请关闭文件,重新上传。');      Exit;    end;    vMPFDS.AddFormField('itemid', IntToStr(ABillID));    vMPFDS.AddFormField('category', ACategory);    vMPFDS.AddFormField('memo', ReplaceCharsForJson(AMemo));    vMPFDS.AddFormField('phase', IntToStr(APhase));    vMPFDS.Position := 0;    try      sResult := vIdHTTP.Post(sURL, vMPFDS);    except      Abort;    end;  finally    vMPFDS.Free;    vIdHTTP.Free;  end;  J := TCslJson.Create;  try    J.Text := Utf8ToAnsi(sResult);    if SameText(J.Value['status'], 'true') then    begin      Result := True;      vArr := VarArrayOf(['onlinefilename', 'imnid', 'fileurl']);      J.ChildValues('iteminfo', vArr);      ANewFileName := vArr[0];      AFileID := vArr[1];      ADownURL := vArr[2];    end    else    begin      Result := False;    end;  finally    J.Free;  end;end;function TPHPWeb.GetAttachmentList(AWebID: Integer; var vArr: TOVArr): Boolean;var sURL: string;begin  sURL := Format('%stender/attachment/%d/list', [FMeasureURL, AWebID]);  Result := Search(sURL, [], [], vArr) = 1;end;function TPHPWeb.ExistInServer(AWebID: Integer): Boolean;var vArr: array of string;  iResult: Integer;  sSearchURL: string;begin  sSearchURL := Format('%stender/get/%d/exist', [PHPWeb.MeasureURL, AWebID]);  vArr := VarArrayOf(['id', 'name']);  iResult := PHPWeb.Search(sSearchURL, [''], [''], vArr);  if (iResult = 1) and (High(vArr) >= 0) then    Result := True  else    Result := False;end;// 格式为 Measure:chenfunction TPHPWeb.GetNameFromURLProtocol(AURLProtocol: string): string;begin  if Trim(AURLProtocol) = '' then    Result := ''  else    Result := Copy(AURLProtocol, 9, Length(AURLProtocol) - 8);end;function TPHPWeb.DeleteAttachment(AFileID: Integer): Integer;var sURL: string;  vArr: array of string;begin  vArr := VarArrayOf(['msg']);  sURL := Format('%stender/attachment/%d/del', [FMeasureURL, AFileID]);  Result := Search(sURL, [], [], vArr);end;function TPHPWeb.UpAttachmentOnLine(AWebID, ABillID, APhase: Integer; AIDAry: array of string): Boolean;//var//  vMPFDS: TIdMultiPartFormDataStream;//  sResult, sURL: string;//  J: TCslJson;//  vArr: array of string;begin{  Result := False;  vMPFDS := TIdMultiPartFormDataStream.Create;  try    sURL := Format('%stender/attachment/%d/%d/upload', [FMeasureURL, AWebID, PHPWeb.UserID]);    vMPFDS.AddFormField('itemid', IntToStr(ABillID));    vMPFDS.AddFormField('phase', IntToStr(APhase));    vMPFDS.Position := 0;    try      sResult := IdHTTP.Post(sURL, vMPFDS);    except      Abort;    end;  finally    vMPFDS.Free;  end;  J := TCslJson.Create;  try    J.Text := Utf8ToAnsi(sResult);    if SameText(J.Value['status'], 'true') then    begin      Result := True;      vArr := VarArrayOf(['onlinefilename']);      J.ChildValues('iteminfo', vArr);      ANewFileName := vArr[0];    end    else    begin      Result := False;    end;  finally    J.Free;  end;  }end;initializationfinalization  if g_PHPWeb <> nil then    g_PHPWeb.Free;end.
 |