PHPWebDm.pas 21 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710
  1. {*******************************************************************************
  2. 单元名称: PHPWebDm.pas
  3. 单元说明: Delphi 同PHP web服务器通信接口。 计量的PHP比造价的PHP多了很多
  4. 作者时间: Chenshilong, 2012-5-13
  5. *******************************************************************************}
  6. unit PHPWebDm;
  7. interface
  8. uses
  9. SysUtils, Classes, IdBaseComponent, IdComponent, IdTCPConnection,
  10. IdTCPClient, IdHTTP, CslJson;
  11. type
  12. // Web连接成功、Web连接失败、登录失败、旧用户需要升级、资料不全
  13. TLoginType = (ltCon, ltDisCon, ltLoginFail, ltUpdate, ltIncomplete);
  14. TPHPWeb = class(TDataModule)
  15. IdHTTP: TIdHTTP;
  16. procedure DataModuleCreate(Sender: TObject);
  17. private
  18. // 远程服务器上时间
  19. FServerDateTime: TDateTime;
  20. FUserID: Integer;
  21. FAccount: string;
  22. FRealName: string;
  23. FUserFlag: Integer; // 用户标志位,用于区分出一部分用户进行特殊控制。
  24. FMeasureURL: string; // http://d.jl.smartcost.com.cn/api/client/
  25. FLoginURL: string;
  26. FLoginBannerURL: string;
  27. FCheckOnLineURL: string;
  28. FPassportURL: string;
  29. FPwdURL: string;
  30. FRegURL: string;
  31. FWebLoginURL: string;
  32. FServerDateTimeURL: string;
  33. FWebSoftURL: string;
  34. FLogoutURL: string;
  35. FRole: string;
  36. FCompany: string;
  37. FUserImageURL: string;
  38. FLoginCloudURL: string;
  39. procedure SetUserID(const Value: Integer);
  40. procedure SetAccount(const Value: string);
  41. procedure SetRealName(const Value: string);
  42. {-------------------------------------------------------------------------------
  43. 方法: CustomSearch()
  44. 描述: 通用的查询接口,集各种复杂情况之大成,宇宙级牛B综合算法,哦耶! ^__^
  45. 【函数返回值】
  46. -1: 网络不通;
  47. 0: 网络通,但登录或查询出错、网页出错等,无法返回约定的
  48. Json格式,通常返回一篇乱码;
  49. 1: 成功(包括返回零记录)
  50. 【参数】
  51. AURL: 请求的网址。
  52. AInFields: 请求的键名字。
  53. AInValues: 请求的键值。
  54. AResultType: 返回值类型:0 返回一维数组;1 返回二维数组;2 两者都。
  55. AOutStrs: 用于存储返回的零散值。需要赋字段名传入。
  56. AOutRecords: 用于存储返回的多条记录、数据表。只需声明,无需定义大
  57. 小和赋值,返回Json的数组,数组的值为'info'对象的值。
  58. 【要求】
  59. ①返回的Json数据中必须有status、msg两个键名字(约定格式)。
  60. ②AResults至少有一个元素,用来存储当返回值为0时查询出错的原因。
  61. 作者: Chenshilong, 2014-07-13
  62. -------------------------------------------------------------------------------}
  63. function CustomSearch(AURL: string; AInFields, AInValues: array of string;
  64. AResultType: Integer; var AOutStrs: array of string;
  65. var AOutRecords: TOVArr): Integer;
  66. public
  67. function SystemDateTime: TDateTime;
  68. function Search(AURL: string; AInFields, AInValues: array of string; var AOutStrs: array of string): Integer; overload;
  69. function Search(AURL: string; AInFields, AInValues: array of string; var AOutRecords: TOVArr): Integer; overload;
  70. function Search(AURL: string; AInFields, AInValues: array of string; var AOutStrs: array of string ; var AOutRecords: TOVArr): Integer; overload;
  71. function Search(AURL: string; AInFields, AInValues: array of string; AResultType: Integer; var AOutStrs: array of string ; var AOutRecords: TOVArr): Integer; overload;
  72. // ALoginType, 登录类型,1 正常情况下的用户名密码;2 紫光平台调用仅用户名无密码
  73. function Login(AAccount, APW: string; ALoginType: Integer; var AInfo, ANewExeURL: string): TLoginType;
  74. function ConnectServer(AIP: string; var ACompanyName: string): Integer; // 新装软件,先弹出设置IP窗口
  75. function UpDataFile(AUserID, ATenderID, APhaseNo: Integer; AFile, AMD5_JL: string;
  76. AIsSubmit: Boolean; var AResultStr: string; ACheckPassed: Boolean; ACheckerMemo: string): Boolean;
  77. function UpAttachmentFile(AUperID, AWebID, ABillID: Integer; AFile,
  78. ACategory, AMemo, APhaseName: string; var ANewFileName: string): Boolean;
  79. function GetAttachmentFileList(AWebID: Integer; var vArr: TOVArr): Boolean;
  80. function zip(AFileArr: array of string): string;
  81. function CheckZip(AZipFile: string; AFileCount: Integer): Boolean; // 检测zip是否能够正确解压出所有文件。
  82. function TempName(ALength: Integer = 12): string;
  83. function WebPath: string;
  84. function UserPath: string;
  85. // 下载文件:源文件网址;存储到本地的位置
  86. function DownFile(ASourceURL: string; var ALocalFile: string): Boolean;
  87. // 用于调试输出值,解决灵异现象(有些现象调试环境正常,运行环境时有时无)
  88. procedure Debug(AFileName, AStr: string); overload;
  89. procedure Debug(AFileName: string; AInFields, AInValues: array of string); overload;
  90. function NetError(AMid: string): string;
  91. function PageError(AMid: string): string;
  92. function ExistInServer(AWebID: Integer): Boolean;
  93. function GetNameFromURLProtocol(AURLProtocol: string): string;
  94. property Account: string read FAccount write SetAccount;
  95. property UserID: Integer read FUserID write SetUserID;
  96. property RealName: string read FRealName write SetRealName;
  97. property UserFlag: Integer read FUserFlag write FUserFlag;
  98. property Company: string read FCompany write FCompany;
  99. property Role: string read FRole write FRole;
  100. property MeasureURL: string read FMeasureURL;
  101. property WebSoftURL: string read FWebSoftURL;
  102. property PassportURL: string read FPassportURL;
  103. property LoginURL: string read FLoginURL;
  104. property WebLoginURL: string read FWebLoginURL;
  105. property LoginBannerURL: string read FLoginBannerURL;
  106. property LogoutURL: string read FLogoutURL;
  107. property RegURL: string read FRegURL;
  108. property PwdURL: string read FPwdURL;
  109. property CheckOnLineURL: string read FCheckOnLineURL;
  110. property ServerDateTimeURL: string read FServerDateTimeURL;
  111. property UserImageURL: string read FUserImageURL write FUserImageURL;
  112. property LoginCloudURL: string read FLoginCloudURL write FLoginCloudURL;
  113. end;
  114. function PHPWeb: TPHPWeb;
  115. // 全国 广东 标后预算 定额排版 港口水工 内河航运 疏浚 清单编制
  116. function ExeCategoryName: string;
  117. implementation
  118. uses
  119. MD5Unit, IdMultipartFormData, VCLUnZip, VCLZip,
  120. IniFiles, Forms, UtilMethods, Variants, ConstUnit{, Controls, Windows};
  121. var g_PHPWeb: TPHPWeb;
  122. {$R *.dfm}
  123. { TPHPWeb }
  124. function PHPWeb: TPHPWeb;
  125. begin
  126. if g_PHPWeb = nil then
  127. g_PHPWeb := TPHPWeb.Create(nil);
  128. Result := g_PHPWeb;
  129. end;
  130. function ExeCategoryName: string;
  131. begin
  132. Result := 'JLZF';
  133. end;
  134. function TPHPWeb.Login(AAccount, APW: string; ALoginType: Integer; var AInfo, ANewExeURL: string): TLoginType;
  135. var vArr: array of string;
  136. begin
  137. vArr := VarArrayOf(['uid', 'name', 'email', 'ucompany', 'jobtitle', 'avatar', 'msg']);
  138. case Search(FMeasureURL + 'signin', ['v4name', 'v4pass', 'version', 'logintype'],
  139. [AnsiToUtf8(AAccount), APW, GetVersion{'0.0.0.0'}, IntToStr(ALoginType)], vArr) of
  140. -1: Result := ltDisCon;
  141. 0:
  142. begin
  143. AInfo := vArr[0];
  144. Result := ltLoginFail;
  145. end;
  146. 1:
  147. begin
  148. FUserID := StrToInt(vArr[0]);
  149. FRealName := vArr[1];
  150. FAccount := AAccount; // vArr[2]
  151. FCompany := vArr[3];
  152. FRole := vArr[4];
  153. FUserImageURL := vArr[5];
  154. AInfo := vArr[6];
  155. Result := ltCon;
  156. end;
  157. 2:
  158. begin
  159. AInfo := vArr[0];
  160. ANewExeURL := vArr[1];
  161. Result := ltUpdate;
  162. end;
  163. end;
  164. end;
  165. procedure TPHPWeb.SetUserID(const Value: Integer);
  166. begin
  167. FUserID := Value;
  168. end;
  169. procedure TPHPWeb.SetAccount(const Value: string);
  170. begin
  171. FAccount := Value;
  172. end;
  173. procedure TPHPWeb.DataModuleCreate(Sender: TObject);
  174. var ini: TIniFile;
  175. begin
  176. FServerDateTime := -1;
  177. ini := TIniFile.Create(ExtractFilePath(Application.ExeName) + 'Cloud.ini');
  178. try
  179. // FMeasureURL := ini.ReadString('URL', 'MeasureURL', '');
  180. FMeasureURL := 'http://' + ini.ReadString('URL', 'Server', '') +
  181. ini.ReadString('URL', 'MeasureURL', '');
  182. FWebSoftURL := ini.ReadString('URL', 'WebSoftURL', '');
  183. FPassportURL := ini.ReadString('URL', 'PassportURL', '');
  184. FLoginCloudURL := ini.ReadString('URL', 'LoginCloudURL', '');
  185. FLoginURL := FWebSoftURL + ini.ReadString('URL', 'LoginURL', '');
  186. FWebLoginURL := FWebSoftURL + ini.ReadString('URL', 'FWebLoginURL', '');
  187. FLoginBannerURL := FWebSoftURL + ini.ReadString('URL', 'LoginBannerURL', '');
  188. FLogoutURL := FWebSoftURL + ini.ReadString('URL', 'LogoutURL', '');
  189. FRegURL := FPassportURL + ini.ReadString('URL', 'RegURL', '');
  190. FPwdURL := FPassportURL + ini.ReadString('URL', 'PwdURL', '');
  191. FCheckOnLineURL := FWebSoftURL + ini.ReadString('URL', 'CheckOnLineURL', '');
  192. FServerDateTimeURL := FWebSoftURL + ini.ReadString('URL', 'ServerDateTimeURL', '');
  193. finally
  194. ini.Free;
  195. end;
  196. end;
  197. procedure TPHPWeb.SetRealName(const Value: string);
  198. begin
  199. FRealName := Value;
  200. end;
  201. function TPHPWeb.zip(AFileArr: array of string): string;
  202. var vZip: TVCLZip;
  203. sAppFile, sZipFile: string;
  204. i: Integer;
  205. begin
  206. Result := 'Error';
  207. sAppFile := AFileArr[Low(AFileArr)];
  208. sZipFile := ExtractFilePath(sAppFile) + ExtractFileNameWithoutExt(sAppFile) + '.up';
  209. if FileExists(sZipFile) then
  210. DeleteFile(sZipFile);
  211. vZip := TVCLZip.Create(nil);
  212. try
  213. for i := Low(AFileArr) to High(AFileArr) do
  214. begin
  215. if FileExists(AFileArr[i]) then
  216. vZip.FilesList.Add(AFileArr[i]);
  217. end;
  218. vZip.ZipName := sZipFile;
  219. // PHP不支持解压加密zip文件
  220. //vZip.Password := 'jlzf.Sc.2014';
  221. vZip.Recurse := True;
  222. vZip.ZipComment := '纵横计量支付';
  223. vZip.OverwriteMode := Always;
  224. vZip.Zip;
  225. Result := sZipFile;
  226. for i := Low(AFileArr) to High(AFileArr) do
  227. DeleteFile(AFileArr[i]);
  228. finally
  229. vZip.Free;
  230. end;
  231. end;
  232. function TPHPWeb.CheckZip(AZipFile: string; AFileCount: Integer): Boolean;
  233. var vUnZip: TVCLUnZip;
  234. begin
  235. vUnZip := TVCLUnZip.Create(nil);
  236. try
  237. vUnZip.ZipName := AZipFile;
  238. vUnZip.DestDir := 'C:\Temp\MeasureTemp\';
  239. vUnZip.DoAll := True;
  240. vUnZip.RecreateDirs := True;
  241. vUnZip.RetainAttributes := True;
  242. vUnZip.OverwriteMode := Always;
  243. Result := (AFileCount = vUnZip.UnZip);
  244. finally
  245. DeleteFolder(vUnZip.DestDir);
  246. vUnZip.Free;
  247. end;
  248. end;
  249. function TPHPWeb.UpDataFile(AUserID, ATenderID, APhaseNo: Integer; AFile, AMD5_JL: string;
  250. AIsSubmit: Boolean; var AResultStr: string; ACheckPassed: Boolean; ACheckerMemo: string): Boolean;
  251. var
  252. IdDataStream: TIdMultiPartFormDataStream;
  253. sResult, sURL: string;
  254. J: TCslJson;
  255. sZipMD5: string;
  256. begin
  257. Result := False;
  258. if not FileExists(AFile) then Exit;
  259. IdDataStream := TIdMultiPartFormDataStream.Create;
  260. try
  261. if ACheckPassed then // 审核通过
  262. begin
  263. if AIsSubmit then
  264. begin
  265. sURL := Format('%speriod/%d/%d/%d/creat', [FMeasureURL, AUserID, ATenderID, APhaseNo])
  266. end
  267. else
  268. begin
  269. sURL := FMeasureURL + 'user/audit/measure';
  270. IdDataStream.AddFormField('userid', IntToStr(AUserID));
  271. IdDataStream.AddFormField('tenderid', IntToStr(ATenderID));
  272. IdDataStream.AddFormField('phaseno', IntToStr(APhaseNo));
  273. IdDataStream.AddFormField('CheckerMemo', ReplaceCharsForJson(ACheckerMemo));
  274. end;
  275. end
  276. else // 审核不通过
  277. begin
  278. sURL := Format('%suser/set/%d/%d/%d/checkno', [FMeasureURL, AUserID, ATenderID, APhaseNo]);
  279. IdDataStream.AddFormField('CheckerMemo', ReplaceCharsForJson(ACheckerMemo));
  280. end;
  281. IdDataStream.AddFile('upfile', AFile, 'text/plain');
  282. IdDataStream.AddFormField('upfile', AFile);
  283. IdDataStream.AddFormField('MD5_JL', AMD5_JL);
  284. sZipMD5 := MD5_File(AFile);
  285. IdDataStream.AddFormField('MD5_Zip', sZipMD5);
  286. IdDataStream.Position := 0;
  287. try
  288. sResult := IdHTTP.Post(sURL, IdDataStream);
  289. except
  290. Abort;
  291. end;
  292. finally
  293. IdDataStream.Free;
  294. DeleteFile(AFile);
  295. end;
  296. J := TCslJson.Create;
  297. try
  298. J.Text := Utf8ToAnsi(sResult);
  299. if SameText(J.Value['status'], 'true') then
  300. Result := True
  301. else
  302. begin
  303. Result := False;
  304. AResultStr := J.Value['msg'];
  305. end;
  306. finally
  307. J.Free;
  308. end;
  309. end;
  310. function TPHPWeb.Search(AURL: string; AInFields, AInValues: array of string; var AOutStrs: array of string): Integer;
  311. var vA: TOVArr;
  312. begin
  313. Result := CustomSearch(AURL, AInFields, AInValues, 0, AOutStrs, vA);
  314. end;
  315. function TPHPWeb.Search(AURL: string; AInFields, AInValues: array of string; var AOutRecords: TOVArr): Integer;
  316. var vA: array of string;
  317. begin
  318. Result := CustomSearch(AURL, AInFields, AInValues, 1, vA, AOutRecords);
  319. end;
  320. function TPHPWeb.Search(AURL: string; AInFields, AInValues: array of string; var AOutStrs: array of string; var AOutRecords: TOVArr): Integer;
  321. begin
  322. Result := CustomSearch(AURL, AInFields, AInValues, 2, AOutStrs, AOutRecords);
  323. end;
  324. function TPHPWeb.Search(AURL: string; AInFields, AInValues: array of string; AResultType: Integer; var AOutStrs: array of string; var AOutRecords: TOVArr): Integer;
  325. begin
  326. Result := CustomSearch(AURL, AInFields, AInValues, 3, AOutStrs, AOutRecords);
  327. end;
  328. function TPHPWeb.TempName(ALength: Integer): string;
  329. const
  330. CodedBuf: array[0..35] of Char = ('0', '1', '2', '3', '4', '5',
  331. '6', '7', '8', '9', 'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H', 'I',
  332. 'J', 'K', 'L', 'M', 'N', 'O', 'P', 'Q', 'R', 'S', 'T', 'U', 'V',
  333. 'W', 'X', 'Y', 'Z');
  334. begin
  335. Result := '';
  336. Randomize;
  337. while Length(Result) < ALength do
  338. Result := Result + CodedBuf[Random(36)];
  339. end;
  340. function TPHPWeb.WebPath: string;
  341. begin
  342. Result := ExtractFilePath(Application.ExeName) + 'Web\';
  343. if not DirectoryExists(Result) then
  344. ForceDirectories(Result);
  345. end;
  346. function TPHPWeb.UserPath: string;
  347. begin
  348. Result := ExtractFilePath(Application.ExeName) + 'Web\Users\' + IntToStr(FUserID) + '\';
  349. if not DirectoryExists(Result) then
  350. ForceDirectories(Result);
  351. end;
  352. function TPHPWeb.DownFile(ASourceURL: string; var ALocalFile: string): Boolean;
  353. var
  354. vStream: TMemoryStream;
  355. iFlag: Integer;
  356. bOK: Boolean;
  357. procedure SafeDownFile(ASourceURL: string; var ALocalFile: string);
  358. begin
  359. Inc(iFlag);
  360. bOK := False;
  361. try
  362. IdHTTP.Get(ASourceURL, vStream);
  363. vStream.SaveToFile(ALocalFile);
  364. bOK := True;
  365. except
  366. bOK := False;
  367. end;
  368. end;
  369. begin
  370. iFlag := 0;
  371. bOK := False;
  372. Result := False;
  373. if Trim(ASourceURL) = '' then Exit;
  374. if Trim(ALocalFile) = '' then Exit;
  375. if (ExtractFileExt(ALocalFile) = '.rmf') and FileExists(ALocalFile) then
  376. DeleteFile(ALocalFile);
  377. vStream := TMemoryStream.Create;
  378. try
  379. while (not bOK) and (iFlag < 3) do // 尝试3次
  380. SafeDownFile(ASourceURL, ALocalFile);
  381. Result := bOK;
  382. finally
  383. vStream.Free;
  384. end;
  385. end;
  386. function TPHPWeb.CustomSearch(AURL: string; AInFields,
  387. AInValues: array of string; AResultType: Integer;
  388. var AOutStrs: array of string; var AOutRecords: TOVArr): Integer;
  389. var
  390. i: Integer;
  391. postList: TStrings;
  392. ssResponse: TStringStream;
  393. bDone: Boolean;
  394. vJson: TCslJson;
  395. begin
  396. Result := -1;
  397. postList := TStringList.Create;
  398. ssResponse := TStringStream.Create('');
  399. try
  400. try
  401. for i := Low(AInFields) to High(AInFields) do
  402. postList.Add(Format('%s=%s', [AInFields[i], AInValues[i]]));
  403. IdHTTP.Post(AURL, postList, ssResponse);
  404. bDone := True;
  405. except
  406. bDone := False;
  407. end;
  408. if (bDone) and (Pos('200 OK', IdHTTP.ResponseText) <> 0) then // 网络已通
  409. begin
  410. vJson := TCslJson.Create;
  411. try
  412. vJson.Text := Utf8ToAnsi(ssResponse.DataString);
  413. if SameText(vJson.Value['status'], 'true') then // 数据读取成功
  414. begin
  415. case AResultType of
  416. 0:
  417. begin
  418. for i := Low(AOutStrs) to High(AOutStrs) do
  419. AOutStrs[i] := vJson.Value[AOutStrs[i]];
  420. end;
  421. 1:
  422. begin
  423. AOutRecords := vJson.ArrayValues('info');
  424. end;
  425. 2:
  426. begin
  427. for i := Low(AOutStrs) to High(AOutStrs) do
  428. AOutStrs[i] := vJson.Value[AOutStrs[i]];
  429. AOutRecords := vJson.ArrayValues('info');
  430. end;
  431. 3:
  432. begin
  433. vJson.ChildValues('info', AOutStrs);
  434. AOutRecords := vJson.ArrayValues('auditinfo');
  435. end;
  436. end;
  437. Result := 1;
  438. end
  439. else if SameText(vJson.Value['status'], 'false') then // 数据读取失败
  440. begin
  441. case AResultType of
  442. 0:
  443. begin
  444. AOutStrs[Low(AOutStrs)] := vJson.Value['msg'];
  445. end;
  446. 1:
  447. begin
  448. SetLength(AOutRecords, 1, 1);
  449. AOutRecords[0, 0] := vJson.Value['msg'];
  450. end;
  451. 2, 3:
  452. begin
  453. AOutStrs[Low(AOutStrs)] := vJson.Value['msg'];
  454. SetLength(AOutRecords, 1, 1);
  455. AOutRecords[0, 0] := vJson.Value['msg'];
  456. end;
  457. end;
  458. Result := 0;
  459. end
  460. else if SameText(vJson.Value['status'], 'upgrade') then
  461. begin
  462. AOutStrs[Low(AOutStrs)] := vJson.Value['msg'];
  463. AOutStrs[Low(AOutStrs) + 1] := vJson.Value['url'];
  464. Result := 2;
  465. end;
  466. finally
  467. vJson.Free;
  468. end;
  469. end;
  470. finally
  471. postList.Free;
  472. ssResponse.Free;
  473. end;
  474. end;
  475. function TPHPWeb.SystemDateTime: TDateTime;
  476. begin
  477. Result := Now;
  478. end;
  479. function TPHPWeb.NetError(AMid: string): string;
  480. begin
  481. Result := Format('当前网络状态较差(-1),%s,请重新尝试或重新登录后再尝试!', [AMid]);
  482. end;
  483. function TPHPWeb.PageError(AMid: string): string;
  484. begin
  485. Result := Format('Web页返回错误(000J),%s,请重新尝试或联系纵横客服。', [AMid]);
  486. end;
  487. procedure TPHPWeb.Debug(AFileName, AStr: string);
  488. var vSL: TStringList;
  489. sAdd: string;
  490. begin
  491. vSL := TStringList.Create;
  492. try
  493. sAdd := Format('%s%d %s %s', [#10#13#10#13#10#13#10#13#10#13,
  494. UserID, RealName, Account]);
  495. vSL.Add(AStr + sAdd);
  496. if Pos('Debug_', AFileName) = 0 then
  497. AFileName := 'Debug_' + AFileName;
  498. vSL.SaveToFile(WebPath + AFileName + '.txt');
  499. finally
  500. vSL.Free;
  501. end;
  502. end;
  503. procedure TPHPWeb.Debug(AFileName: string; AInFields, AInValues: array of string);
  504. var vSL: TStringList;
  505. sAdd: string;
  506. i: Integer;
  507. begin
  508. if G_IsTest then
  509. begin
  510. vSL := TStringList.Create;
  511. try
  512. sAdd := Format('%s%d %s %s', [#10#13#10#13#10#13#10#13#10#13, UserID, RealName, Account]);
  513. for i := Low(AInFields) to High(AInFields) do
  514. vSL.Add(AInFields[i] + #9#9 + AInValues[i]);
  515. vSL.Add(sAdd);
  516. if Pos('Debug_', AFileName) = 0 then
  517. AFileName := 'Debug_' + AFileName;
  518. vSL.SaveToFile(WebPath + AFileName + '.txt');
  519. finally
  520. vSL.Free;
  521. end;
  522. end;
  523. end;
  524. function TPHPWeb.ConnectServer(AIP: string; var ACompanyName: string): Integer;
  525. var vArr: array of string;
  526. sURL: string;
  527. begin
  528. sURL := Format('http://%s/api/client/software/title', [AIP]);
  529. vArr := VarArrayOf(['msg']);
  530. Result := Search(sURL, [], [], vArr);
  531. case Result of
  532. -1: ACompanyName := '地址不存在';
  533. 0: ACompanyName := '服务器Web页错误';
  534. 1: ACompanyName := vArr[0];
  535. end;
  536. end;
  537. function TPHPWeb.UpAttachmentFile(AUperID, AWebID, ABillID: Integer; AFile,
  538. ACategory, AMemo, APhaseName: string; var ANewFileName: string): Boolean;
  539. var
  540. vMPFDS: TIdMultiPartFormDataStream;
  541. sResult, sURL: string;
  542. J: TCslJson;
  543. vArr: array of string;
  544. begin
  545. Result := False;
  546. if not FileExists(AFile) then
  547. begin
  548. // Application.MessageBox(PChar(AFile + ' 文件不存在!'), '错误', MB_OK + MB_ICONERROR);
  549. Exit;
  550. end;
  551. vMPFDS := TIdMultiPartFormDataStream.Create;
  552. try
  553. sURL := Format('%stender/attachment/%d/%d/upload', [FMeasureURL, AWebID, AUperID]);
  554. vMPFDS.AddFile('upitem', AFile, 'text/plain');
  555. vMPFDS.AddFormField('itemid', IntToStr(ABillID));
  556. vMPFDS.AddFormField('Category', ACategory);
  557. vMPFDS.AddFormField('Memo', ReplaceCharsForJson(AMemo));
  558. vMPFDS.AddFormField('PhaseName', APhaseName);
  559. vMPFDS.Position := 0;
  560. try
  561. sResult := IdHTTP.Post(sURL, vMPFDS);
  562. except
  563. Abort;
  564. end;
  565. finally
  566. vMPFDS.Free;
  567. end;
  568. J := TCslJson.Create;
  569. try
  570. J.Text := Utf8ToAnsi(sResult);
  571. if SameText(J.Value['status'], 'true') then
  572. begin
  573. Result := True;
  574. vArr := VarArrayOf(['onlinefilename']);
  575. J.ChildValues('iteminfo', vArr);
  576. ANewFileName := vArr[0];
  577. end
  578. else
  579. begin
  580. Result := False;
  581. end;
  582. finally
  583. J.Free;
  584. end;
  585. end;
  586. function TPHPWeb.GetAttachmentFileList(AWebID: Integer; var vArr: TOVArr): Boolean;
  587. var sURL: string;
  588. begin
  589. sURL := Format('%stender/attachment/%d/list', [FMeasureURL, AWebID]);
  590. Result := Search(sURL, [], [], vArr) = 1;
  591. end;
  592. function TPHPWeb.ExistInServer(AWebID: Integer): Boolean;
  593. var vArr: array of string;
  594. iResult: Integer;
  595. sSearchURL: string;
  596. begin
  597. sSearchURL := Format('%stender/get/%d/exist', [PHPWeb.MeasureURL, AWebID]);
  598. vArr := VarArrayOf(['id', 'name']);
  599. iResult := PHPWeb.Search(sSearchURL, [''], [''], vArr);
  600. if (iResult = 1) and (High(vArr) >= 0) then
  601. Result := True
  602. else
  603. Result := False;
  604. end;
  605. // 格式为 Measure:chen
  606. function TPHPWeb.GetNameFromURLProtocol(AURLProtocol: string): string;
  607. begin
  608. if Trim(AURLProtocol) = '' then
  609. Result := ''
  610. else
  611. Result := Copy(AURLProtocol, 9, Length(AURLProtocol) - 8);
  612. end;
  613. initialization
  614. finalization
  615. if g_PHPWeb <> nil then
  616. g_PHPWeb.Free;
  617. end.