Программа для прослушивания журнала АРК Томск http://blindage.org/?p=6627
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

142 lines
3.7KB

  1. unit Unit1;
  2. {$mode objfpc}{$H+}
  3. interface
  4. uses
  5. Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
  6. ComCtrls, ExtCtrls, httpsend, blcksock, Zipper, ShellApi;
  7. type
  8. { TForm1 }
  9. TForm1 = class(TForm)
  10. Label1: TLabel;
  11. ProgressBar1: TProgressBar;
  12. Timer1: TTimer;
  13. procedure SockCallBack(Sender: TObject; Reason: THookSocketReason;
  14. const Value: string);
  15. procedure Timer1Timer(Sender: TObject);
  16. private
  17. { private declarations }
  18. http: THTTPSend;
  19. TotalBytes: longint;
  20. CurrentBytes: longint;
  21. public
  22. { public declarations }
  23. end;
  24. var
  25. Form1: TForm1;
  26. implementation
  27. {$R *.lfm}
  28. { TForm1 }
  29. function MemoryStreamToString(M: TMemoryStream): string;
  30. begin
  31. SetString(Result, PChar(M.Memory), M.Size div SizeOf(char));
  32. end;
  33. procedure TForm1.SockCallBack(Sender: TObject; Reason: THookSocketReason;
  34. const Value: string);
  35. begin
  36. case Reason of
  37. HR_ReadCount:
  38. begin
  39. Inc(CurrentBytes, StrToIntDef(Value, 0)); // Increment uploaded bytes
  40. if TotalBytes > 0 then
  41. ProgressBar1.Position := Round(CurrentBytes * (100 / TotalBytes));
  42. Application.ProcessMessages;
  43. end;
  44. HR_CanRead:
  45. begin
  46. TotalBytes := http.DownloadSize;
  47. end;
  48. HR_Connect:
  49. begin
  50. CurrentBytes := 0;
  51. end;
  52. end;
  53. end;
  54. procedure TForm1.Timer1Timer(Sender: TObject);
  55. var
  56. memstream: TMemoryStream;
  57. need_update: boolean;
  58. current_version: TStringList;
  59. remote_version: string;
  60. UnZipper: TUnZipper;
  61. begin
  62. Timer1.Enabled := False;
  63. Application.ProcessMessages;
  64. need_update := False;
  65. current_version := TStringList.Create;
  66. try
  67. current_version.LoadFromFile('version');
  68. except
  69. current_version.Text := 'update';
  70. current_version.SaveToFile('version');
  71. end;
  72. http := THTTPSend.Create;
  73. with http do
  74. begin
  75. if HTTPMethod('GET', 'http://avto.opentomsk.net/dist/version.w32') then
  76. try
  77. memstream := TMemoryStream.Create;
  78. memstream := Document;
  79. remote_version := MemoryStreamToString(memstream);
  80. if remote_version <> current_version.Strings[0] then
  81. begin
  82. need_update := True;
  83. memstream.SaveToFile(UTF8ToSys('version'));
  84. end;
  85. memstream.Free;
  86. except
  87. //Application.MessageBox('Ошибка при скачивании файла', 'Error', 0);
  88. end;
  89. end;
  90. if need_update then
  91. begin
  92. Label1.Caption := 'Идет обновление ПО. Подождите...';
  93. Application.ProcessMessages;
  94. http := THTTPSend.Create;
  95. with http do
  96. begin
  97. Sock.OnStatus := @SockCallBack;
  98. if HTTPMethod('GET', 'http://avto.opentomsk.net/dist/avtokanal.w32.zip') then
  99. try
  100. Application.ProcessMessages;
  101. memstream := TMemoryStream.Create;
  102. memstream := Document;
  103. memstream.SaveToFile(UTF8ToSys('avtokanal.w32.zip'));
  104. memstream.Free;
  105. Label1.Caption := 'Обновление получено';
  106. except
  107. //Application.MessageBox('Ошибка при скачивании файла', 'Error', 0);
  108. Label1.Caption := 'Обновление не получено';
  109. end;
  110. end;
  111. Application.ProcessMessages;
  112. UnZipper := TUnZipper.Create;
  113. try
  114. UnZipper.FileName := 'avtokanal.w32.zip';
  115. UnZipper.OutputPath := '';
  116. UnZipper.Examine;
  117. UnZipper.UnZipAllFiles;
  118. finally
  119. UnZipper.Free;
  120. end;
  121. //ShowMessage('Программа обновлена до версии '+remote_version);
  122. end;
  123. ShellExecute(0,nil, PChar('avtokanal.exe'),PChar(''),nil,1);
  124. Close;
  125. end;
  126. end.