PHPWebDm.pas 26 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917
  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. procedure DataModuleCreate(Sender: TObject);
  16. private
  17. // 远程服务器上时间
  18. FServerDateTime: TDateTime;
  19. FUserID: Integer;
  20. FAccount: string;
  21. FRealName: string;
  22. FUserFlag: Integer; // 用户标志位,用于区分出一部分用户进行特殊控制。
  23. FMeasureURL: string; // http://d.jl.smartcost.com.cn/api/client/
  24. FLoginURL: string;
  25. FLoginBannerURL: string;
  26. FCheckOnLineURL: string;
  27. FPassportURL: string;
  28. FPwdURL: string;
  29. FRegURL: string;
  30. FWebLoginURL: string;
  31. FServerDateTimeURL: string;
  32. FWebSoftURL: string;
  33. FLogoutURL: string;
  34. FRole: string;
  35. FCompany: string;
  36. FUserImageURL: string;
  37. FLoginCloudURL: string;
  38. procedure SetUserID(const Value: Integer);
  39. procedure SetAccount(const Value: string);
  40. procedure SetRealName(const Value: string);
  41. {-------------------------------------------------------------------------------
  42. 方法: CustomSearch()
  43. 描述: 通用的查询接口,集各种复杂情况之大成,宇宙级牛B综合算法,哦耶! ^__^
  44. 【函数返回值】
  45. -1: 网络不通;
  46. 0: 网络通,但登录或查询出错、网页出错等,无法返回约定的
  47. Json格式,通常返回一篇乱码;
  48. 1: 成功(包括返回零记录)
  49. 【参数】
  50. AURL: 请求的网址。
  51. AInFields: 请求的键名字。
  52. AInValues: 请求的键值。
  53. AResultType: 返回值类型:0 返回一维数组;1 返回二维数组;2 两者都。
  54. AOutStrs: 用于存储返回的零散值。需要赋字段名传入。
  55. AOutRecords: 用于存储返回的多条记录、数据表。只需声明,无需定义大
  56. 小和赋值,返回Json的数组,数组的值为'info'对象的值。
  57. 【要求】
  58. ①返回的Json数据中必须有status、msg两个键名字(约定格式)。
  59. ②AResults至少有一个元素,用来存储当返回值为0时查询出错的原因。
  60. 作者: Chenshilong, 2014-07-13
  61. -------------------------------------------------------------------------------}
  62. function CustomSearch(AURL: string; AInFields, AInValues: array of string;
  63. AResultType: Integer; var AOutStrs: array of string;
  64. var AOutRecords: TOVArr): Integer;
  65. public
  66. function SystemDateTime: TDateTime;
  67. function Search(AURL: string; AInFields, AInValues: array of string; var AOutStrs: array of string): Integer; overload;
  68. function Search(AURL: string; AInFields, AInValues: array of string; var AOutRecords: TOVArr): Integer; overload;
  69. function Search(AURL: string; AInFields, AInValues: array of string; var AOutStrs: array of string ; var AOutRecords: TOVArr): Integer; overload;
  70. function Search(AURL: string; AInFields, AInValues: array of string; AResultType: Integer; var AOutStrs: array of string ; var AOutRecords: TOVArr): Integer; overload;
  71. // ALoginType, 登录类型,1 正常情况下的用户名密码;2 紫光平台调用仅用户名无密码
  72. function Login(AAccount, APW: string; ALoginType: Integer; var AInfo, ANewExeURL: string): TLoginType;
  73. function ConnectServer(AIP: string; var ACompanyName: string): Integer; // 新装软件,先弹出设置IP窗口
  74. function UpDataFile(AUserID, ATenderID, APhaseNo: Integer; AFile, AMD5_JL: string;
  75. AIsSubmit: Boolean; var AResultStr: string; ACheckPassed: Boolean; ACheckerMemo: string): Boolean;
  76. function UpAttachment(AUperID, AWebID, ABillID, APhase: Integer; AFile, ACategory, AMemo: string; var ANewFileName, AFileID, ADownURL: string): Boolean;
  77. function UpAttachmentOnLine(AWebID, ABillID, APhase: Integer; AIDAry: array of string): Boolean;
  78. function DeleteAttachment(AFileID: Integer): Integer;
  79. function GetAttachmentList(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. function UploadFile(AUrl: string; AInFields, AInValues: array of string;
  95. AFileName: string; var ErrorMessage: string): Boolean;
  96. function UploadFiles(AUrl: string; AInFields, AInValues: array of string;
  97. AUpFileFields, AUpFileNames: array of string; var ErrorMessage: string): Boolean;
  98. function UrlGet(AUrl: string; APostParam: TStrings; var AResult: TStrings): Integer;
  99. property Account: string read FAccount write SetAccount;
  100. property UserID: Integer read FUserID write SetUserID;
  101. property RealName: string read FRealName write SetRealName;
  102. property UserFlag: Integer read FUserFlag write FUserFlag;
  103. property Company: string read FCompany write FCompany;
  104. property Role: string read FRole write FRole;
  105. property MeasureURL: string read FMeasureURL;
  106. property WebSoftURL: string read FWebSoftURL;
  107. property PassportURL: string read FPassportURL;
  108. property LoginURL: string read FLoginURL;
  109. property WebLoginURL: string read FWebLoginURL;
  110. property LoginBannerURL: string read FLoginBannerURL;
  111. property LogoutURL: string read FLogoutURL;
  112. property RegURL: string read FRegURL;
  113. property PwdURL: string read FPwdURL;
  114. property CheckOnLineURL: string read FCheckOnLineURL;
  115. property ServerDateTimeURL: string read FServerDateTimeURL;
  116. property UserImageURL: string read FUserImageURL write FUserImageURL;
  117. property LoginCloudURL: string read FLoginCloudURL write FLoginCloudURL;
  118. end;
  119. function PHPWeb: TPHPWeb;
  120. // 全国 广东 标后预算 定额排版 港口水工 内河航运 疏浚 清单编制
  121. function ExeCategoryName: string;
  122. implementation
  123. uses
  124. MD5Unit, IdMultipartFormData, VCLUnZip, VCLZip,
  125. IniFiles, Forms, UtilMethods, Variants, ConstUnit, ScUtils;{, Controls, Windows}
  126. var g_PHPWeb: TPHPWeb;
  127. {$R *.dfm}
  128. { TPHPWeb }
  129. function PHPWeb: TPHPWeb;
  130. begin
  131. if g_PHPWeb = nil then
  132. g_PHPWeb := TPHPWeb.Create(nil);
  133. Result := g_PHPWeb;
  134. end;
  135. function ExeCategoryName: string;
  136. begin
  137. Result := 'JLZF';
  138. end;
  139. function TPHPWeb.Login(AAccount, APW: string; ALoginType: Integer; var AInfo, ANewExeURL: string): TLoginType;
  140. var vArr: array of string;
  141. begin
  142. vArr := VarArrayOf(['uid', 'name', 'email', 'ucompany', 'jobtitle', 'avatar', 'msg']);
  143. case Search(FMeasureURL + 'signin', ['v4name', 'v4pass', 'version', 'logintype'],
  144. [AnsiToUtf8(AAccount), APW, GetVersion{'0.0.0.0'}, IntToStr(ALoginType)], vArr) of
  145. -1: Result := ltDisCon;
  146. 0:
  147. begin
  148. AInfo := vArr[0];
  149. Result := ltLoginFail;
  150. end;
  151. 1:
  152. begin
  153. FUserID := StrToInt(vArr[0]);
  154. FRealName := vArr[1];
  155. FAccount := AAccount; // vArr[2]
  156. FCompany := vArr[3];
  157. FRole := vArr[4];
  158. FUserImageURL := vArr[5];
  159. AInfo := vArr[6];
  160. Result := ltCon;
  161. end;
  162. 2:
  163. begin
  164. AInfo := vArr[0];
  165. ANewExeURL := vArr[1];
  166. Result := ltUpdate;
  167. end;
  168. end;
  169. end;
  170. procedure TPHPWeb.SetUserID(const Value: Integer);
  171. begin
  172. FUserID := Value;
  173. end;
  174. procedure TPHPWeb.SetAccount(const Value: string);
  175. begin
  176. FAccount := Value;
  177. end;
  178. procedure TPHPWeb.DataModuleCreate(Sender: TObject);
  179. var ini: TIniFile;
  180. begin
  181. FServerDateTime := -1;
  182. ini := TIniFile.Create(ExtractFilePath(Application.ExeName) + 'Cloud.ini');
  183. try
  184. // FMeasureURL := ini.ReadString('URL', 'MeasureURL', '');
  185. FMeasureURL := 'http://' + ini.ReadString('URL', 'Server', '') +
  186. ini.ReadString('URL', 'MeasureURL', '');
  187. FWebSoftURL := ini.ReadString('URL', 'WebSoftURL', '');
  188. FPassportURL := ini.ReadString('URL', 'PassportURL', '');
  189. FLoginCloudURL := ini.ReadString('URL', 'LoginCloudURL', '');
  190. FLoginURL := FWebSoftURL + ini.ReadString('URL', 'LoginURL', '');
  191. FWebLoginURL := FWebSoftURL + ini.ReadString('URL', 'FWebLoginURL', '');
  192. FLoginBannerURL := FWebSoftURL + ini.ReadString('URL', 'LoginBannerURL', '');
  193. FLogoutURL := FWebSoftURL + ini.ReadString('URL', 'LogoutURL', '');
  194. FRegURL := FPassportURL + ini.ReadString('URL', 'RegURL', '');
  195. FPwdURL := FPassportURL + ini.ReadString('URL', 'PwdURL', '');
  196. FCheckOnLineURL := FWebSoftURL + ini.ReadString('URL', 'CheckOnLineURL', '');
  197. FServerDateTimeURL := FWebSoftURL + ini.ReadString('URL', 'ServerDateTimeURL', '');
  198. finally
  199. ini.Free;
  200. end;
  201. end;
  202. procedure TPHPWeb.SetRealName(const Value: string);
  203. begin
  204. FRealName := Value;
  205. end;
  206. function TPHPWeb.zip(AFileArr: array of string): string;
  207. var vZip: TVCLZip;
  208. sAppFile, sZipFile: string;
  209. i: Integer;
  210. begin
  211. Result := 'Error';
  212. sAppFile := AFileArr[Low(AFileArr)];
  213. sZipFile := ExtractFilePath(sAppFile) + ExtractFileNameWithoutExt(sAppFile) + '.up';
  214. if FileExists(sZipFile) then
  215. DeleteFile(sZipFile);
  216. vZip := TVCLZip.Create(nil);
  217. try
  218. for i := Low(AFileArr) to High(AFileArr) do
  219. begin
  220. if FileExists(AFileArr[i]) then
  221. vZip.FilesList.Add(AFileArr[i]);
  222. end;
  223. vZip.ZipName := sZipFile;
  224. // PHP不支持解压加密zip文件
  225. //vZip.Password := 'jlzf.Sc.2014';
  226. vZip.Recurse := True;
  227. vZip.ZipComment := '纵横计量支付';
  228. vZip.OverwriteMode := Always;
  229. vZip.Zip;
  230. Result := sZipFile;
  231. for i := Low(AFileArr) to High(AFileArr) do
  232. DeleteFile(AFileArr[i]);
  233. finally
  234. vZip.Free;
  235. end;
  236. end;
  237. function TPHPWeb.CheckZip(AZipFile: string; AFileCount: Integer): Boolean;
  238. var vUnZip: TVCLUnZip;
  239. begin
  240. vUnZip := TVCLUnZip.Create(nil);
  241. try
  242. vUnZip.ZipName := AZipFile;
  243. vUnZip.DestDir := 'C:\Temp\MeasureTemp\';
  244. vUnZip.DoAll := True;
  245. vUnZip.RecreateDirs := True;
  246. vUnZip.RetainAttributes := True;
  247. vUnZip.OverwriteMode := Always;
  248. Result := (AFileCount = vUnZip.UnZip);
  249. finally
  250. DeleteFolder(vUnZip.DestDir);
  251. vUnZip.Free;
  252. end;
  253. end;
  254. function TPHPWeb.UpDataFile(AUserID, ATenderID, APhaseNo: Integer; AFile, AMD5_JL: string;
  255. AIsSubmit: Boolean; var AResultStr: string; ACheckPassed: Boolean; ACheckerMemo: string): Boolean;
  256. var
  257. IdDataStream: TIdMultiPartFormDataStream;
  258. sResult, sURL: string;
  259. J: TCslJson;
  260. sZipMD5: string;
  261. vIdHttp: TIdHTTP;
  262. begin
  263. Result := False;
  264. if not FileExists(AFile) then Exit;
  265. IdDataStream := TIdMultiPartFormDataStream.Create;
  266. vIdHTTP := TIdHTTP.Create(nil);
  267. try
  268. if ACheckPassed then // 审核通过
  269. begin
  270. if AIsSubmit then
  271. begin
  272. sURL := Format('%speriod/%d/%d/%d/creat', [FMeasureURL, AUserID, ATenderID, APhaseNo])
  273. end
  274. else
  275. begin
  276. sURL := FMeasureURL + 'user/audit/measure';
  277. IdDataStream.AddFormField('userid', IntToStr(AUserID));
  278. IdDataStream.AddFormField('tenderid', IntToStr(ATenderID));
  279. IdDataStream.AddFormField('phaseno', IntToStr(APhaseNo));
  280. IdDataStream.AddFormField('CheckerMemo', ReplaceCharsForJson(ACheckerMemo));
  281. end;
  282. end
  283. else // 审核不通过
  284. begin
  285. sURL := Format('%suser/set/%d/%d/%d/checkno', [FMeasureURL, AUserID, ATenderID, APhaseNo]);
  286. IdDataStream.AddFormField('CheckerMemo', ReplaceCharsForJson(ACheckerMemo));
  287. end;
  288. IdDataStream.AddFile('upfile', AFile, 'text/plain');
  289. IdDataStream.AddFormField('upfile', AFile);
  290. IdDataStream.AddFormField('MD5_JL', AMD5_JL);
  291. sZipMD5 := MD5_File(AFile);
  292. IdDataStream.AddFormField('MD5_Zip', sZipMD5);
  293. IdDataStream.Position := 0;
  294. try
  295. sResult := vIdHTTP.Post(sURL, IdDataStream);
  296. except
  297. Abort;
  298. end;
  299. finally
  300. IdDataStream.Free;
  301. vIdHttp.Free;
  302. DeleteFile(AFile);
  303. end;
  304. J := TCslJson.Create;
  305. try
  306. J.Text := Utf8ToAnsi(sResult);
  307. if SameText(J.Value['status'], 'true') then
  308. Result := True
  309. else
  310. begin
  311. Result := False;
  312. AResultStr := J.Value['msg'];
  313. end;
  314. finally
  315. J.Free;
  316. end;
  317. end;
  318. function TPHPWeb.Search(AURL: string; AInFields, AInValues: array of string; var AOutStrs: array of string): Integer;
  319. var vA: TOVArr;
  320. begin
  321. Result := CustomSearch(AURL, AInFields, AInValues, 0, AOutStrs, vA);
  322. end;
  323. function TPHPWeb.Search(AURL: string; AInFields, AInValues: array of string; var AOutRecords: TOVArr): Integer;
  324. var vA: array of string;
  325. begin
  326. Result := CustomSearch(AURL, AInFields, AInValues, 1, vA, AOutRecords);
  327. end;
  328. function TPHPWeb.Search(AURL: string; AInFields, AInValues: array of string; var AOutStrs: array of string; var AOutRecords: TOVArr): Integer;
  329. begin
  330. Result := CustomSearch(AURL, AInFields, AInValues, 2, AOutStrs, AOutRecords);
  331. end;
  332. function TPHPWeb.Search(AURL: string; AInFields, AInValues: array of string; AResultType: Integer; var AOutStrs: array of string; var AOutRecords: TOVArr): Integer;
  333. begin
  334. Result := CustomSearch(AURL, AInFields, AInValues, 3, AOutStrs, AOutRecords);
  335. end;
  336. function TPHPWeb.TempName(ALength: Integer): string;
  337. const
  338. CodedBuf: array[0..35] of Char = ('0', '1', '2', '3', '4', '5',
  339. '6', '7', '8', '9', 'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H', 'I',
  340. 'J', 'K', 'L', 'M', 'N', 'O', 'P', 'Q', 'R', 'S', 'T', 'U', 'V',
  341. 'W', 'X', 'Y', 'Z');
  342. begin
  343. Result := '';
  344. Randomize;
  345. while Length(Result) < ALength do
  346. Result := Result + CodedBuf[Random(36)];
  347. end;
  348. function TPHPWeb.WebPath: string;
  349. begin
  350. Result := ExtractFilePath(Application.ExeName) + 'Web\';
  351. if not DirectoryExists(Result) then
  352. ForceDirectories(Result);
  353. end;
  354. function TPHPWeb.UserPath: string;
  355. begin
  356. Result := ExtractFilePath(Application.ExeName) + 'Web\Users\' + IntToStr(FUserID) + '\';
  357. if not DirectoryExists(Result) then
  358. ForceDirectories(Result);
  359. end;
  360. function TPHPWeb.DownFile(ASourceURL: string; var ALocalFile: string): Boolean;
  361. var
  362. vStream: TMemoryStream;
  363. iFlag: Integer;
  364. bOK: Boolean;
  365. vIdHTTP: TIdHTTP;
  366. procedure SafeDownFile(ASourceURL: string; var ALocalFile: string);
  367. begin
  368. Inc(iFlag);
  369. bOK := False;
  370. try
  371. vIdHTTP.Get(ASourceURL, vStream);
  372. vStream.SaveToFile(ALocalFile);
  373. bOK := True;
  374. except
  375. bOK := False;
  376. end;
  377. end;
  378. begin
  379. iFlag := 0;
  380. bOK := False;
  381. Result := False;
  382. if Trim(ASourceURL) = '' then Exit;
  383. if Trim(ALocalFile) = '' then Exit;
  384. if (ExtractFileExt(ALocalFile) = '.rmf') and FileExists(ALocalFile) then
  385. DeleteFile(ALocalFile);
  386. vStream := TMemoryStream.Create;
  387. vIdHTTP := TIdHTTP.Create(nil);
  388. try
  389. while (not bOK) and (iFlag < 3) do // 尝试3次
  390. SafeDownFile(ASourceURL, ALocalFile);
  391. Result := bOK;
  392. finally
  393. vStream.Free;
  394. vIdHTTP.Free;
  395. end;
  396. end;
  397. function TPHPWeb.CustomSearch(AURL: string; AInFields,
  398. AInValues: array of string; AResultType: Integer;
  399. var AOutStrs: array of string; var AOutRecords: TOVArr): Integer;
  400. var
  401. i: Integer;
  402. postList: TStrings;
  403. ssResponse: TStringStream;
  404. bDone: Boolean;
  405. vJson: TCslJson;
  406. vIdHTTP: TIdHTTP;
  407. begin
  408. Result := -1;
  409. postList := TStringList.Create;
  410. ssResponse := TStringStream.Create('');
  411. vIdHTTP := TIdHTTP.Create(nil);
  412. try
  413. try
  414. for i := Low(AInFields) to High(AInFields) do
  415. postList.Add(Format('%s=%s', [AInFields[i], AInValues[i]]));
  416. vIdHTTP.Post(AURL, postList, ssResponse);
  417. bDone := True;
  418. except
  419. bDone := False;
  420. end;
  421. if (bDone) and (Pos('200 OK', vIdHTTP.ResponseText) <> 0) then // 网络已通
  422. begin
  423. vJson := TCslJson.Create;
  424. try
  425. vJson.Text := Utf8ToAnsi(ssResponse.DataString);
  426. if SameText(vJson.Value['status'], 'true') then // 数据读取成功
  427. begin
  428. case AResultType of
  429. 0:
  430. begin
  431. for i := Low(AOutStrs) to High(AOutStrs) do
  432. AOutStrs[i] := vJson.Value[AOutStrs[i]];
  433. end;
  434. 1:
  435. begin
  436. AOutRecords := vJson.ArrayValues('info');
  437. end;
  438. 2:
  439. begin
  440. for i := Low(AOutStrs) to High(AOutStrs) do
  441. AOutStrs[i] := vJson.Value[AOutStrs[i]];
  442. AOutRecords := vJson.ArrayValues('info');
  443. end;
  444. 3:
  445. begin
  446. vJson.ChildValues('info', AOutStrs);
  447. AOutRecords := vJson.ArrayValues('auditinfo');
  448. end;
  449. end;
  450. Result := 1;
  451. end
  452. else if SameText(vJson.Value['status'], 'false') then // 数据读取失败
  453. begin
  454. case AResultType of
  455. 0:
  456. begin
  457. AOutStrs[Low(AOutStrs)] := vJson.Value['msg'];
  458. end;
  459. 1:
  460. begin
  461. SetLength(AOutRecords, 1, 1);
  462. AOutRecords[0, 0] := vJson.Value['msg'];
  463. end;
  464. 2, 3:
  465. begin
  466. AOutStrs[Low(AOutStrs)] := vJson.Value['msg'];
  467. SetLength(AOutRecords, 1, 1);
  468. AOutRecords[0, 0] := vJson.Value['msg'];
  469. end;
  470. end;
  471. Result := 0;
  472. end
  473. else if SameText(vJson.Value['status'], 'upgrade') then
  474. begin
  475. AOutStrs[Low(AOutStrs)] := vJson.Value['msg'];
  476. AOutStrs[Low(AOutStrs) + 1] := vJson.Value['url'];
  477. Result := 2;
  478. end;
  479. finally
  480. vJson.Free;
  481. end;
  482. end;
  483. finally
  484. postList.Free;
  485. ssResponse.Free;
  486. vIdHTTP.Free;
  487. end;
  488. end;
  489. function TPHPWeb.SystemDateTime: TDateTime;
  490. begin
  491. Result := Now;
  492. end;
  493. function TPHPWeb.NetError(AMid: string): string;
  494. begin
  495. Result := Format('当前网络状态较差(-1),%s,请重新尝试或重新登录后再尝试!', [AMid]);
  496. end;
  497. function TPHPWeb.PageError(AMid: string): string;
  498. begin
  499. Result := Format('Web页返回错误(000J),%s,请重新尝试或联系纵横客服。', [AMid]);
  500. end;
  501. procedure TPHPWeb.Debug(AFileName, AStr: string);
  502. var vSL: TStringList;
  503. sAdd: string;
  504. begin
  505. vSL := TStringList.Create;
  506. try
  507. sAdd := Format('%s%d %s %s', [#10#13#10#13#10#13#10#13#10#13,
  508. UserID, RealName, Account]);
  509. vSL.Add(AStr + sAdd);
  510. if Pos('Debug_', AFileName) = 0 then
  511. AFileName := 'Debug_' + AFileName;
  512. vSL.SaveToFile(WebPath + AFileName + '.txt');
  513. finally
  514. vSL.Free;
  515. end;
  516. end;
  517. procedure TPHPWeb.Debug(AFileName: string; AInFields, AInValues: array of string);
  518. var vSL: TStringList;
  519. sAdd: string;
  520. i: Integer;
  521. begin
  522. if G_IsTest then
  523. begin
  524. vSL := TStringList.Create;
  525. try
  526. sAdd := Format('%s%d %s %s', [#10#13#10#13#10#13#10#13#10#13, UserID, RealName, Account]);
  527. for i := Low(AInFields) to High(AInFields) do
  528. vSL.Add(AInFields[i] + #9#9 + AInValues[i]);
  529. vSL.Add(sAdd);
  530. if Pos('Debug_', AFileName) = 0 then
  531. AFileName := 'Debug_' + AFileName;
  532. vSL.SaveToFile(WebPath + AFileName + '.txt');
  533. finally
  534. vSL.Free;
  535. end;
  536. end;
  537. end;
  538. function TPHPWeb.ConnectServer(AIP: string; var ACompanyName: string): Integer;
  539. var vArr: array of string;
  540. sURL: string;
  541. begin
  542. sURL := Format('http://%s/api/client/software/title', [AIP]);
  543. vArr := VarArrayOf(['msg']);
  544. Result := Search(sURL, [], [], vArr);
  545. case Result of
  546. -1: ACompanyName := '地址不存在';
  547. 0: ACompanyName := '服务器Web页错误';
  548. 1: ACompanyName := vArr[0];
  549. end;
  550. end;
  551. function TPHPWeb.UpAttachment(AUperID, AWebID, ABillID, APhase: Integer; AFile,
  552. ACategory, AMemo: string; var ANewFileName, AFileID, ADownURL: string): Boolean;
  553. var
  554. vMPFDS: TIdMultiPartFormDataStream;
  555. sResult, sURL: string;
  556. J: TCslJson;
  557. vArr: array of string;
  558. vIdHTTP: TIdHTTP;
  559. begin
  560. Result := False;
  561. if not FileExists(AFile) then
  562. begin
  563. // Application.MessageBox(PChar(AFile + ' 文件不存在!'), '错误', MB_OK + MB_ICONERROR);
  564. Exit;
  565. end;
  566. vMPFDS := TIdMultiPartFormDataStream.Create;
  567. vIdHTTP := TIdHTTP.Create(nil);
  568. try
  569. sURL := Format('%stender/attachment/%d/%d/upload', [FMeasureURL, AWebID, AUperID]);
  570. // 如果文件已被打开,这里会报错。
  571. try
  572. vMPFDS.AddFile('upitem', AFile, 'text/plain');
  573. except
  574. MessageHint(0, '当前文件处于打开状态,请关闭文件,重新上传。');
  575. Exit;
  576. end;
  577. vMPFDS.AddFormField('itemid', IntToStr(ABillID));
  578. vMPFDS.AddFormField('category', ACategory);
  579. vMPFDS.AddFormField('memo', ReplaceCharsForJson(AMemo));
  580. vMPFDS.AddFormField('phase', IntToStr(APhase));
  581. vMPFDS.Position := 0;
  582. try
  583. sResult := vIdHTTP.Post(sURL, vMPFDS);
  584. except
  585. Abort;
  586. end;
  587. finally
  588. vMPFDS.Free;
  589. vIdHTTP.Free;
  590. end;
  591. J := TCslJson.Create;
  592. try
  593. J.Text := Utf8ToAnsi(sResult);
  594. if SameText(J.Value['status'], 'true') then
  595. begin
  596. Result := True;
  597. vArr := VarArrayOf(['onlinefilename', 'imnid', 'fileurl']);
  598. J.ChildValues('iteminfo', vArr);
  599. ANewFileName := vArr[0];
  600. AFileID := vArr[1];
  601. ADownURL := vArr[2];
  602. end
  603. else
  604. begin
  605. Result := False;
  606. end;
  607. finally
  608. J.Free;
  609. end;
  610. end;
  611. function TPHPWeb.GetAttachmentList(AWebID: Integer; var vArr: TOVArr): Boolean;
  612. var sURL: string;
  613. begin
  614. sURL := Format('%stender/attachment/%d/list', [FMeasureURL, AWebID]);
  615. Result := Search(sURL, [], [], vArr) = 1;
  616. end;
  617. function TPHPWeb.ExistInServer(AWebID: Integer): Boolean;
  618. var vArr: array of string;
  619. iResult: Integer;
  620. sSearchURL: string;
  621. begin
  622. sSearchURL := Format('%stender/get/%d/exist', [PHPWeb.MeasureURL, AWebID]);
  623. vArr := VarArrayOf(['id', 'name']);
  624. iResult := PHPWeb.Search(sSearchURL, [''], [''], vArr);
  625. if (iResult = 1) and (High(vArr) >= 0) then
  626. Result := True
  627. else
  628. Result := False;
  629. end;
  630. // 格式为 Measure:chen
  631. function TPHPWeb.GetNameFromURLProtocol(AURLProtocol: string): string;
  632. begin
  633. if Trim(AURLProtocol) = '' then
  634. Result := ''
  635. else
  636. Result := Copy(AURLProtocol, 9, Length(AURLProtocol) - 8);
  637. end;
  638. function TPHPWeb.DeleteAttachment(AFileID: Integer): Integer;
  639. var sURL: string;
  640. vArr: array of string;
  641. begin
  642. vArr := VarArrayOf(['msg']);
  643. sURL := Format('%stender/attachment/%d/del', [FMeasureURL, AFileID]);
  644. Result := Search(sURL, [], [], vArr);
  645. end;
  646. function TPHPWeb.UpAttachmentOnLine(AWebID, ABillID, APhase: Integer; AIDAry: array of string): Boolean;
  647. //var
  648. // vMPFDS: TIdMultiPartFormDataStream;
  649. // sResult, sURL: string;
  650. // J: TCslJson;
  651. // vArr: array of string;
  652. begin
  653. { Result := False;
  654. vMPFDS := TIdMultiPartFormDataStream.Create;
  655. try
  656. sURL := Format('%stender/attachment/%d/%d/upload', [FMeasureURL, AWebID, PHPWeb.UserID]);
  657. vMPFDS.AddFormField('itemid', IntToStr(ABillID));
  658. vMPFDS.AddFormField('phase', IntToStr(APhase));
  659. vMPFDS.Position := 0;
  660. try
  661. sResult := IdHTTP.Post(sURL, vMPFDS);
  662. except
  663. Abort;
  664. end;
  665. finally
  666. vMPFDS.Free;
  667. end;
  668. J := TCslJson.Create;
  669. try
  670. J.Text := Utf8ToAnsi(sResult);
  671. if SameText(J.Value['status'], 'true') then
  672. begin
  673. Result := True;
  674. vArr := VarArrayOf(['onlinefilename']);
  675. J.ChildValues('iteminfo', vArr);
  676. ANewFileName := vArr[0];
  677. end
  678. else
  679. begin
  680. Result := False;
  681. end;
  682. finally
  683. J.Free;
  684. end; }
  685. end;
  686. function TPHPWeb.UploadFile(AUrl: string; AInFields,
  687. AInValues: array of string; AFileName: string; var ErrorMessage: string): Boolean;
  688. var
  689. IdDataStream: TIdMultiPartFormDataStream;
  690. i: Integer;
  691. sPostResult: string;
  692. J: TCslJson;
  693. vIdHttp: TIdHTTP;
  694. begin
  695. Result := False;
  696. if not FileExists(AFileName) then Exit;
  697. IdDataStream := TIdMultiPartFormDataStream.Create;
  698. vIdHTTP := TIdHTTP.Create(nil);
  699. try
  700. for i := Low(AInFields) to High(AInFields) do
  701. IdDataStream.AddFormField(AInFields[i], AInValues[i]);
  702. IdDataStream.AddFile('upfile', AFileName, 'text/plain');
  703. IdDataStream.Position := 0;
  704. try
  705. sPostResult := vIdHTTP.Post(MeasureURL + AUrl, IdDataStream);
  706. J := TCslJson.Create;
  707. J.Text := Utf8ToAnsi(sPostResult);
  708. Result := SameText(J.Value['status'], 'true');
  709. if not Result then
  710. ErrorMessage := J.Value['msg'];
  711. finally
  712. J.Free;
  713. end;
  714. finally
  715. IdDataStream.Free;
  716. vIdHttp.Free;
  717. end;
  718. end;
  719. function TPHPWeb.UploadFiles(AUrl: string; AInFields, AInValues,
  720. AUpFileFields, AUpFileNames: array of string;
  721. var ErrorMessage: string): Boolean;
  722. var
  723. IdDataStream: TIdMultiPartFormDataStream;
  724. i: Integer;
  725. sPostResult: string;
  726. J: TCslJson;
  727. vIdHttp: TIdHTTP;
  728. begin
  729. Result := False;
  730. for i := Low(AUpFileNames) to High(AUpFileNames) do
  731. if not FileExists(AUpFileNames[i]) then Exit;
  732. IdDataStream := TIdMultiPartFormDataStream.Create;
  733. vIdHTTP := TIdHTTP.Create(nil);
  734. try
  735. for i := Low(AInFields) to High(AInFields) do
  736. IdDataStream.AddFormField(AInFields[i], AInValues[i]);
  737. for i := Low(AUpFileFields) to High(AUpFileFields) do
  738. IdDataStream.AddFile(AUpFileFields[i], AUpFileNames[i], 'text/plain');
  739. IdDataStream.Position := 0;
  740. try
  741. sPostResult := vIdHTTP.Post(MeasureURL + AUrl, IdDataStream);
  742. J := TCslJson.Create;
  743. J.Text := Utf8ToAnsi(sPostResult);
  744. Result := SameText(J.Value['status'], 'true');
  745. if not Result then
  746. ErrorMessage := J.Value['msg'];
  747. finally
  748. J.Free;
  749. end;
  750. finally
  751. IdDataStream.Free;
  752. vIdHttp.Free;
  753. end;
  754. end;
  755. function TPHPWeb.UrlGet(AUrl: string; APostParam: TStrings;
  756. var AResult: TStrings): Integer;
  757. var
  758. i: Integer;
  759. postList: TStrings;
  760. ssResponse: TStringStream;
  761. bDone: Boolean;
  762. vJson: TCslJson;
  763. vIdHTTP: TIdHTTP;
  764. begin
  765. Result := -1;
  766. ssResponse := TStringStream.Create('');
  767. vIdHTTP := TIdHTTP.Create(nil);
  768. try
  769. vIdHTTP.Post(AUrl, APostParam, ssResponse);
  770. if (Pos('200 OK', vIdHTTP.ResponseText) <> 0) then
  771. begin
  772. // Analyse Result Json
  773. vJson := TCslJson.Create;
  774. try
  775. vJson.Text := Utf8ToAnsi(ssResponse.DataString);
  776. if SameText(vJson.Value['status'], 'true') then
  777. begin
  778. vJson.ValueStrings('info', AResult);
  779. Result := 1;
  780. end
  781. else if SameText(vJson.Value['status'], 'false') then
  782. begin
  783. AResult.Add(vJson.Value['msg']);
  784. Result := 0;
  785. end
  786. else
  787. begin
  788. AResult.Add('查询数据出错, 请重试');
  789. Result := 0;
  790. end;
  791. finally
  792. vJson.Free;
  793. end;
  794. end;
  795. finally
  796. vIdHTTP.Free;
  797. ssResponse.Free;
  798. end;
  799. end;
  800. initialization
  801. finalization
  802. if g_PHPWeb <> nil then
  803. g_PHPWeb.Free;
  804. end.