123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771 |
- {*******************************************************************************
- 单元名称: PHPWebDm.pas
- 单元说明: Delphi 同PHP web服务器通信接口。 计量的PHP比造价的PHP多了很多
- 作者时间: Chenshilong, 2012-5-13
- *******************************************************************************}
- unit PHPWebDm;
- interface
- uses
- 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, ACheckCode: 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: 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;
- implementation
- uses
- 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, ACheckCode: string): TLoginType;
- var vArr: array of string;
- begin
- vArr := VarArrayOf(['uid', 'name', 'email', 'ucompany', 'jobtitle', 'avatar', 'msg']);
- case Search(FMeasureURL + 'signin', ['v3name', 'v3pass', 'logintype'], [AnsiToUtf8(AAccount), APW, 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;
- 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 // 数据读取失败
- 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;
- 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: 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']);
- J.ChildValues('iteminfo', vArr);
- ANewFileName := vArr[0];
- AFileID := vArr[1];
- 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:chen
- function 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;
- initialization
- finalization
- if g_PHPWeb <> nil then
- g_PHPWeb.Free;
- end.
|