Browse Source

import

tags/v1.1
Vladimir Smagin 1 year ago
commit
d0a3ebdd2d
76 changed files with 37620 additions and 0 deletions
  1. BIN
      Actions-go-jump-today-icon.png
  2. BIN
      access_point.png
  3. BIN
      ajax-loader.gif
  4. BIN
      ark tomsk.png
  5. BIN
      avtokanal.exe
  6. BIN
      avtokanal.ico
  7. 130
    0
      avtokanal.lpi
  8. 22
    0
      avtokanal.lpr
  9. 460
    0
      avtokanal.lps
  10. BIN
      avtokanal.res
  11. 130
    0
      backup/avtokanal.lpi.bak
  12. 460
    0
      backup/avtokanal.lps.bak
  13. 2512
    0
      backup/unit1.lfm.bak
  14. 405
    0
      backup/unit1.pas.bak
  15. 4333
    0
      blcksock.pas
  16. 845
    0
      httpsend.pas
  17. BIN
      laucher/ark_laucher.exe
  18. BIN
      laucher/ark_laucher.ico
  19. 126
    0
      laucher/ark_laucher.lpi
  20. 23
    0
      laucher/ark_laucher.lpr
  21. 241
    0
      laucher/ark_laucher.lps
  22. BIN
      laucher/ark_laucher.res
  23. BIN
      laucher/avtokanal.ico
  24. 126
    0
      laucher/backup/ark_laucher.lpi.bak
  25. 22
    0
      laucher/backup/ark_laucher.lpr.bak
  26. 241
    0
      laucher/backup/ark_laucher.lps.bak
  27. 34
    0
      laucher/backup/unit1.lfm.bak
  28. 141
    0
      laucher/backup/unit1.pas.bak
  29. 4333
    0
      laucher/blcksock.pas
  30. 845
    0
      laucher/httpsend.pas
  31. 1615
    0
      laucher/sswin32.inc
  32. 1461
    0
      laucher/synacode.pas
  33. 141
    0
      laucher/synafpc.pas
  34. 422
    0
      laucher/synaip.pas
  35. 2339
    0
      laucher/synaser.pas
  36. 2065
    0
      laucher/synautil.pas
  37. 77
    0
      laucher/synsock.pas
  38. 34
    0
      laucher/unit1.lfm
  39. 141
    0
      laucher/unit1.pas
  40. 1
    0
      laucher/version
  41. BIN
      laz_refresh.png
  42. 5
    0
      lib/i386-win32/avtokanal.compiled
  43. BIN
      lib/i386-win32/avtokanal.o
  44. BIN
      lib/i386-win32/avtokanal.or
  45. BIN
      lib/i386-win32/avtokanal.res
  46. 2512
    0
      lib/i386-win32/unit1.lfm
  47. BIN
      lib/i386-win32/unit1.o
  48. BIN
      lib/i386-win32/unit1.ppu
  49. 5
    0
      lib/x86_64-win64/avtokanal.compiled
  50. BIN
      lib/x86_64-win64/avtokanal.o
  51. BIN
      lib/x86_64-win64/avtokanal.obj
  52. BIN
      lib/x86_64-win64/avtokanal.res
  53. BIN
      lib/x86_64-win64/bass.o
  54. BIN
      lib/x86_64-win64/bass.ppu
  55. BIN
      lib/x86_64-win64/libimpbass.a
  56. 298
    0
      lib/x86_64-win64/unit1.lfm
  57. BIN
      lib/x86_64-win64/unit1.o
  58. BIN
      lib/x86_64-win64/unit1.ppu
  59. BIN
      libmysql.dll
  60. BIN
      libmysql_32.dll
  61. BIN
      libmysql_64.dll
  62. BIN
      mpg123.exe
  63. 37
    0
      playlist.csv
  64. 1615
    0
      sswin32.inc
  65. 1461
    0
      synacode.pas
  66. 141
    0
      synafpc.pas
  67. 422
    0
      synaip.pas
  68. 2339
    0
      synaser.pas
  69. 2065
    0
      synautil.pas
  70. 77
    0
      synsock.pas
  71. BIN
      tcalendar.png
  72. 2512
    0
      unit1.lfm
  73. 405
    0
      unit1.pas
  74. 1
    0
      version
  75. BIN
      web/avtokanal.png
  76. BIN
      web/avtokanal_logo.png

BIN
Actions-go-jump-today-icon.png View File


BIN
access_point.png View File


BIN
ajax-loader.gif View File


BIN
ark tomsk.png View File


BIN
avtokanal.exe View File


BIN
avtokanal.ico View File


+ 130
- 0
avtokanal.lpi View File

@@ -0,0 +1,130 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="9"/>
<PathDelim Value="\"/>
<General>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<Title Value="АРК Томск"/>
<ResourceType Value="res"/>
<UseXPManifest Value="True"/>
<Icon Value="0"/>
</General>
<i18n>
<EnableI18N LFM="False"/>
</i18n>
<VersionInfo>
<StringTable ProductVersion=""/>
</VersionInfo>
<BuildModes Count="1">
<Item1 Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
</local>
</RunParams>
<RequiredPackages Count="3">
<Item1>
<PackageName Value="FCL"/>
</Item1>
<Item2>
<PackageName Value="SQLDBLaz"/>
</Item2>
<Item3>
<PackageName Value="LCL"/>
</Item3>
</RequiredPackages>
<Units Count="10">
<Unit0>
<Filename Value="avtokanal.lpr"/>
<IsPartOfProject Value="True"/>
</Unit0>
<Unit1>
<Filename Value="unit1.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="Form1"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="Unit1"/>
</Unit1>
<Unit2>
<Filename Value="blcksock.pas"/>
<IsPartOfProject Value="True"/>
</Unit2>
<Unit3>
<Filename Value="synsock.pas"/>
<IsPartOfProject Value="True"/>
</Unit3>
<Unit4>
<Filename Value="httpsend.pas"/>
<IsPartOfProject Value="True"/>
</Unit4>
<Unit5>
<Filename Value="synacode.pas"/>
<IsPartOfProject Value="True"/>
</Unit5>
<Unit6>
<Filename Value="synafpc.pas"/>
<IsPartOfProject Value="True"/>
</Unit6>
<Unit7>
<Filename Value="synaip.pas"/>
<IsPartOfProject Value="True"/>
</Unit7>
<Unit8>
<Filename Value="synautil.pas"/>
<IsPartOfProject Value="True"/>
</Unit8>
<Unit9>
<Filename Value="synaser.pas"/>
<IsPartOfProject Value="True"/>
</Unit9>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="avtokanal"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="lib\i386-win32"/>
</SearchPaths>
<CodeGeneration>
<TargetCPU Value="i386"/>
<TargetOS Value="win32"/>
<Optimizations>
<OptimizationLevel Value="2"/>
</Optimizations>
</CodeGeneration>
<Linking>
<Debugging>
<GenerateDebugInfo Value="False"/>
</Debugging>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
</CompilerOptions>
<Debugging>
<Exceptions Count="3">
<Item1>
<Name Value="EAbort"/>
</Item1>
<Item2>
<Name Value="ECodetoolError"/>
</Item2>
<Item3>
<Name Value="EFOpenError"/>
</Item3>
</Exceptions>
</Debugging>
</CONFIG>

+ 22
- 0
avtokanal.lpr View File

@@ -0,0 +1,22 @@
program avtokanal;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Interfaces, // this includes the LCL widgetset
Forms, Unit1, httpsend, synacode, synafpc, synaip, synaser, synautil, synsock,
blcksock;
{$R *.res}
begin
Application.Title:='АРК Томск';
RequireDerivedFormResource := True;
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.

+ 460
- 0
avtokanal.lps View File

@@ -0,0 +1,460 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectSession>
<PathDelim Value="\"/>
<Version Value="9"/>
<BuildModes Active="Default"/>
<Units Count="45">
<Unit0>
<Filename Value="avtokanal.lpr"/>
<IsPartOfProject Value="True"/>
<EditorIndex Value="1"/>
<CursorPos X="8" Y="22"/>
<UsageCount Value="86"/>
<Loaded Value="True"/>
</Unit0>
<Unit1>
<Filename Value="unit1.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="Form1"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="Unit1"/>
<IsVisibleTab Value="True"/>
<TopLine Value="215"/>
<CursorPos X="71" Y="276"/>
<FoldState Value=" T3kK091162224G"/>
<UsageCount Value="86"/>
<Loaded Value="True"/>
<LoadedDesigner Value="True"/>
</Unit1>
<Unit2>
<Filename Value="blcksock.pas"/>
<IsPartOfProject Value="True"/>
<EditorIndex Value="-1"/>
<TopLine Value="3731"/>
<CursorPos Y="3756"/>
<UsageCount Value="36"/>
</Unit2>
<Unit3>
<Filename Value="synsock.pas"/>
<IsPartOfProject Value="True"/>
<EditorIndex Value="-1"/>
<TopLine Value="27"/>
<CursorPos X="6" Y="62"/>
<UsageCount Value="37"/>
</Unit3>
<Unit4>
<Filename Value="httpsend.pas"/>
<IsPartOfProject Value="True"/>
<EditorIndex Value="-1"/>
<TopLine Value="336"/>
<CursorPos Y="351"/>
<UsageCount Value="37"/>
</Unit4>
<Unit5>
<Filename Value="synacode.pas"/>
<IsPartOfProject Value="True"/>
<EditorIndex Value="-1"/>
<TopLine Value="434"/>
<CursorPos Y="475"/>
<UsageCount Value="37"/>
</Unit5>
<Unit6>
<Filename Value="synafpc.pas"/>
<IsPartOfProject Value="True"/>
<EditorIndex Value="-1"/>
<WindowIndex Value="-1"/>
<TopLine Value="-1"/>
<CursorPos X="-1" Y="-1"/>
<UsageCount Value="37"/>
</Unit6>
<Unit7>
<Filename Value="synaip.pas"/>
<IsPartOfProject Value="True"/>
<EditorIndex Value="-1"/>
<TopLine Value="165"/>
<CursorPos Y="189"/>
<UsageCount Value="37"/>
</Unit7>
<Unit8>
<Filename Value="synautil.pas"/>
<IsPartOfProject Value="True"/>
<EditorIndex Value="-1"/>
<TopLine Value="1060"/>
<CursorPos Y="1077"/>
<UsageCount Value="37"/>
</Unit8>
<Unit9>
<Filename Value="synaser.pas"/>
<IsPartOfProject Value="True"/>
<EditorIndex Value="-1"/>
<WindowIndex Value="-1"/>
<TopLine Value="-1"/>
<CursorPos X="-1" Y="-1"/>
<UsageCount Value="37"/>
</Unit9>
<Unit10>
<Filename Value="C:\lazarus\fpc\2.6.4\source\rtl\objpas\sysutils\sysstrh.inc"/>
<CursorPos X="40" Y="27"/>
<UsageCount Value="5"/>
</Unit10>
<Unit11>
<Filename Value="C:\lazarus\components\paslibvlc\PasLibVlcPlayer.pas"/>
<CursorPos X="34" Y="3"/>
<UsageCount Value="5"/>
<DefaultSyntaxHighlighter Value="Delphi"/>
</Unit11>
<Unit12>
<Filename Value="C:\lazarus\components\vlc\reglazvlc.pas"/>
<CursorPos Y="4"/>
<UsageCount Value="5"/>
</Unit12>
<Unit13>
<Filename Value="C:\lazarus\debugger\processdebugger.pp"/>
<TopLine Value="95"/>
<CursorPos X="14" Y="121"/>
<UsageCount Value="5"/>
</Unit13>
<Unit14>
<Filename Value="C:\lazarus\ide\main.pp"/>
<TopLine Value="12954"/>
<CursorPos X="3" Y="12980"/>
<UsageCount Value="5"/>
</Unit14>
<Unit15>
<Filename Value="C:\lazarus\components\lazutils\lazutf8sysutils.pas"/>
<TopLine Value="3"/>
<CursorPos X="45" Y="29"/>
<UsageCount Value="6"/>
</Unit15>
<Unit16>
<Filename Value="C:\lazarus\fpc\2.6.4\source\packages\fcl-process\src\process.pp"/>
<EditorIndex Value="-1"/>
<TopLine Value="4"/>
<CursorPos X="48" Y="24"/>
<UsageCount Value="31"/>
</Unit16>
<Unit17>
<Filename Value="C:\lazarus\components\lazutils\utf8process.pp"/>
<EditorIndex Value="-1"/>
<TopLine Value="35"/>
<CursorPos X="58" Y="57"/>
<UsageCount Value="30"/>
</Unit17>
<Unit18>
<Filename Value="C:\lazarus\synapse\source\lib\sswin32.inc"/>
<EditorIndex Value="-1"/>
<WindowIndex Value="-1"/>
<TopLine Value="-1"/>
<CursorPos X="-1" Y="-1"/>
<UsageCount Value="18"/>
</Unit18>
<Unit19>
<Filename Value="C:\lazarus\lcl\include\messagedialogs.inc"/>
<EditorIndex Value="-1"/>
<TopLine Value="174"/>
<CursorPos Y="201"/>
<UsageCount Value="11"/>
</Unit19>
<Unit20>
<Filename Value="C:\lazarus\components\lazutils\lazlogger.pas"/>
<EditorIndex Value="-1"/>
<TopLine Value="741"/>
<CursorPos Y="784"/>
<UsageCount Value="11"/>
</Unit20>
<Unit21>
<Filename Value="C:\lazarus\lcl\include\lclintf.inc"/>
<EditorIndex Value="-1"/>
<TopLine Value="152"/>
<CursorPos Y="178"/>
<UsageCount Value="11"/>
</Unit21>
<Unit22>
<Filename Value="C:\lazarus\lcl\interfaces\win32\win32lclintf.inc"/>
<EditorIndex Value="-1"/>
<TopLine Value="141"/>
<CursorPos Y="167"/>
<UsageCount Value="11"/>
</Unit22>
<Unit23>
<Filename Value="C:\lazarus\lcl\themes.pas"/>
<EditorIndex Value="-1"/>
<TopLine Value="539"/>
<CursorPos Y="565"/>
<UsageCount Value="11"/>
</Unit23>
<Unit24>
<Filename Value="C:\lazarus\lcl\interfaces\win32\win32object.inc"/>
<EditorIndex Value="-1"/>
<TopLine Value="134"/>
<CursorPos Y="167"/>
<UsageCount Value="11"/>
</Unit24>
<Unit25>
<Filename Value="C:\lazarus\lcl\include\application.inc"/>
<EditorIndex Value="-1"/>
<TopLine Value="1116"/>
<CursorPos Y="1147"/>
<UsageCount Value="11"/>
</Unit25>
<Unit26>
<Filename Value="C:\lazarus\lcl\lclproc.pas"/>
<EditorIndex Value="-1"/>
<TopLine Value="2914"/>
<CursorPos Y="2940"/>
<UsageCount Value="11"/>
</Unit26>
<Unit27>
<Filename Value="C:\lazarus\components\lazutils\lazutf8.pas"/>
<EditorIndex Value="-1"/>
<TopLine Value="3278"/>
<CursorPos Y="3293"/>
<UsageCount Value="11"/>
</Unit27>
<Unit28>
<Filename Value="C:\lazarus\lcl\buttons.pp"/>
<EditorIndex Value="-1"/>
<TopLine Value="490"/>
<CursorPos Y="549"/>
<UsageCount Value="11"/>
</Unit28>
<Unit29>
<Filename Value="C:\lazarus\lcl\interfaces\win32\win32wsdialogs.pp"/>
<EditorIndex Value="-1"/>
<TopLine Value="155"/>
<CursorPos Y="173"/>
<UsageCount Value="11"/>
</Unit29>
<Unit30>
<Filename Value="C:\lazarus\lcl\include\screen.inc"/>
<EditorIndex Value="-1"/>
<TopLine Value="246"/>
<CursorPos Y="274"/>
<UsageCount Value="11"/>
</Unit30>
<Unit31>
<Filename Value="C:\lazarus\lcl\include\wincontrol.inc"/>
<EditorIndex Value="-1"/>
<TopLine Value="7233"/>
<CursorPos Y="7259"/>
<UsageCount Value="11"/>
</Unit31>
<Unit32>
<Filename Value="C:\lazarus\lcl\include\winapi.inc"/>
<EditorIndex Value="-1"/>
<TopLine Value="775"/>
<CursorPos Y="801"/>
<UsageCount Value="11"/>
</Unit32>
<Unit33>
<Filename Value="C:\lazarus\lcl\interfaces\win32\win32winapi.inc"/>
<EditorIndex Value="-1"/>
<TopLine Value="2920"/>
<CursorPos Y="2946"/>
<UsageCount Value="11"/>
</Unit33>
<Unit34>
<Filename Value="C:\lazarus\lcl\grids.pas"/>
<UnitName Value="Grids"/>
<EditorIndex Value="2"/>
<TopLine Value="2343"/>
<CursorPos Y="2370"/>
<UsageCount Value="17"/>
<Loaded Value="True"/>
</Unit34>
<Unit35>
<Filename Value="C:\lazarus\lcl\interfaces\win32\win32proc.pp"/>
<EditorIndex Value="-1"/>
<TopLine Value="1087"/>
<CursorPos Y="1121"/>
<UsageCount Value="9"/>
</Unit35>
<Unit36>
<Filename Value="C:\lazarus\lcl\lresources.pp"/>
<EditorIndex Value="-1"/>
<TopLine Value="1473"/>
<CursorPos Y="1502"/>
<UsageCount Value="9"/>
</Unit36>
<Unit37>
<Filename Value="C:\lazarus\lcl\include\icon.inc"/>
<EditorIndex Value="-1"/>
<TopLine Value="674"/>
<CursorPos Y="700"/>
<UsageCount Value="9"/>
</Unit37>
<Unit38>
<Filename Value="C:\lazarus\lcl\include\rasterimage.inc"/>
<EditorIndex Value="-1"/>
<TopLine Value="147"/>
<CursorPos Y="188"/>
<UsageCount Value="9"/>
</Unit38>
<Unit39>
<Filename Value="C:\lazarus\lcl\include\sharedrasterimage.inc"/>
<EditorIndex Value="-1"/>
<CursorPos Y="49"/>
<UsageCount Value="9"/>
</Unit39>
<Unit40>
<Filename Value="C:\lazarus\lcl\intfgraphics.pas"/>
<EditorIndex Value="-1"/>
<TopLine Value="3411"/>
<CursorPos Y="3437"/>
<UsageCount Value="9"/>
</Unit40>
<Unit41>
<Filename Value="C:\lazarus\lcl\include\graphic.inc"/>
<EditorIndex Value="-1"/>
<TopLine Value="30"/>
<CursorPos Y="56"/>
<UsageCount Value="9"/>
</Unit41>
<Unit42>
<Filename Value="C:\lazarus\lcl\graphtype.pp"/>
<EditorIndex Value="-1"/>
<TopLine Value="1738"/>
<CursorPos Y="1778"/>
<UsageCount Value="9"/>
</Unit42>
<Unit43>
<Filename Value="C:\lazarus\lcl\graphics.pp"/>
<EditorIndex Value="-1"/>
<TopLine Value="2262"/>
<CursorPos Y="2305"/>
<UsageCount Value="9"/>
</Unit43>
<Unit44>
<Filename Value="C:\lazarus\lcl\include\intfbaselcl.inc"/>
<EditorIndex Value="-1"/>
<TopLine Value="298"/>
<CursorPos Y="323"/>
<UsageCount Value="9"/>
</Unit44>
</Units>
<JumpHistory Count="30" HistoryIndex="29">
<Position1>
<Filename Value="unit1.pas"/>
<Caret Line="229" Column="38" TopLine="194"/>
</Position1>
<Position2>
<Filename Value="unit1.pas"/>
<Caret Line="207" Column="16" TopLine="172"/>
</Position2>
<Position3>
<Filename Value="unit1.pas"/>
<Caret Line="68" Column="5" TopLine="26"/>
</Position3>
<Position4>
<Filename Value="unit1.pas"/>
<Caret Line="160" Column="22" TopLine="141"/>
</Position4>
<Position5>
<Filename Value="unit1.pas"/>
<Caret Line="141" Column="25" TopLine="130"/>
</Position5>
<Position6>
<Filename Value="unit1.pas"/>
<Caret Line="135" Column="23" TopLine="110"/>
</Position6>
<Position7>
<Filename Value="unit1.pas"/>
<Caret Line="115" Column="48" TopLine="76"/>
</Position7>
<Position8>
<Filename Value="unit1.pas"/>
<Caret Line="68" Column="52" TopLine="67"/>
</Position8>
<Position9>
<Filename Value="unit1.pas"/>
<Caret Line="283" Column="9" TopLine="258"/>
</Position9>
<Position10>
<Filename Value="unit1.pas"/>
<Caret Line="68" Column="15" TopLine="44"/>
</Position10>
<Position11>
<Filename Value="unit1.pas"/>
<Caret Line="280" Column="70" TopLine="254"/>
</Position11>
<Position12>
<Filename Value="unit1.pas"/>
<Caret Line="283" Column="58" TopLine="258"/>
</Position12>
<Position13>
<Filename Value="unit1.pas"/>
<Caret Line="149" Column="35" TopLine="133"/>
</Position13>
<Position14>
<Filename Value="unit1.pas"/>
<Caret Line="68" Column="59" TopLine="62"/>
</Position14>
<Position15>
<Filename Value="unit1.pas"/>
<Caret Line="285" Column="5" TopLine="284"/>
</Position15>
<Position16>
<Filename Value="unit1.pas"/>
<Caret Line="284" Column="5" TopLine="283"/>
</Position16>
<Position17>
<Filename Value="unit1.pas"/>
<Caret Line="280" Column="22" TopLine="254"/>
</Position17>
<Position18>
<Filename Value="unit1.pas"/>
<Caret Line="354" Column="29" TopLine="15"/>
</Position18>
<Position19>
<Filename Value="unit1.pas"/>
<Caret Line="131" Column="14" TopLine="90"/>
</Position19>
<Position20>
<Filename Value="avtokanal.lpr"/>
<Caret Line="21"/>
</Position20>
<Position21>
<Filename Value="unit1.pas"/>
<Caret Line="143" Column="19" TopLine="132"/>
</Position21>
<Position22>
<Filename Value="unit1.pas"/>
<Caret Line="289" Column="88" TopLine="131"/>
</Position22>
<Position23>
<Filename Value="unit1.pas"/>
<Caret Line="315" TopLine="202"/>
</Position23>
<Position24>
<Filename Value="unit1.pas"/>
<Caret Line="316" Column="32" TopLine="202"/>
</Position24>
<Position25>
<Filename Value="unit1.pas"/>
<Caret Line="318" Column="20" TopLine="202"/>
</Position25>
<Position26>
<Filename Value="unit1.pas"/>
<Caret Line="373" Column="51" TopLine="298"/>
</Position26>
<Position27>
<Filename Value="unit1.pas"/>
<Caret Line="38" Column="19" TopLine="13"/>
</Position27>
<Position28>
<Filename Value="unit1.pas"/>
<Caret Line="56" Column="29" TopLine="13"/>
</Position28>
<Position29>
<Filename Value="unit1.pas"/>
<Caret Line="131" Column="34" TopLine="104"/>
</Position29>
<Position30>
<Filename Value="unit1.pas"/>
<Caret Line="328" Column="18" TopLine="216"/>
</Position30>
</JumpHistory>
</ProjectSession>
</CONFIG>

BIN
avtokanal.res View File


+ 130
- 0
backup/avtokanal.lpi.bak View File

@@ -0,0 +1,130 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="9"/>
<PathDelim Value="\"/>
<General>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<Title Value="АРК Томск"/>
<ResourceType Value="res"/>
<UseXPManifest Value="True"/>
<Icon Value="0"/>
</General>
<i18n>
<EnableI18N LFM="False"/>
</i18n>
<VersionInfo>
<StringTable ProductVersion=""/>
</VersionInfo>
<BuildModes Count="1">
<Item1 Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
</local>
</RunParams>
<RequiredPackages Count="3">
<Item1>
<PackageName Value="FCL"/>
</Item1>
<Item2>
<PackageName Value="SQLDBLaz"/>
</Item2>
<Item3>
<PackageName Value="LCL"/>
</Item3>
</RequiredPackages>
<Units Count="10">
<Unit0>
<Filename Value="avtokanal.lpr"/>
<IsPartOfProject Value="True"/>
</Unit0>
<Unit1>
<Filename Value="unit1.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="Form1"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="Unit1"/>
</Unit1>
<Unit2>
<Filename Value="blcksock.pas"/>
<IsPartOfProject Value="True"/>
</Unit2>
<Unit3>
<Filename Value="synsock.pas"/>
<IsPartOfProject Value="True"/>
</Unit3>
<Unit4>
<Filename Value="httpsend.pas"/>
<IsPartOfProject Value="True"/>
</Unit4>
<Unit5>
<Filename Value="synacode.pas"/>
<IsPartOfProject Value="True"/>
</Unit5>
<Unit6>
<Filename Value="synafpc.pas"/>
<IsPartOfProject Value="True"/>
</Unit6>
<Unit7>
<Filename Value="synaip.pas"/>
<IsPartOfProject Value="True"/>
</Unit7>
<Unit8>
<Filename Value="synautil.pas"/>
<IsPartOfProject Value="True"/>
</Unit8>
<Unit9>
<Filename Value="synaser.pas"/>
<IsPartOfProject Value="True"/>
</Unit9>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="avtokanal"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="lib\i386-win32"/>
</SearchPaths>
<CodeGeneration>
<TargetCPU Value="i386"/>
<TargetOS Value="win32"/>
<Optimizations>
<OptimizationLevel Value="2"/>
</Optimizations>
</CodeGeneration>
<Linking>
<Debugging>
<GenerateDebugInfo Value="False"/>
</Debugging>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
</CompilerOptions>
<Debugging>
<Exceptions Count="3">
<Item1>
<Name Value="EAbort"/>
</Item1>
<Item2>
<Name Value="ECodetoolError"/>
</Item2>
<Item3>
<Name Value="EFOpenError"/>
</Item3>
</Exceptions>
</Debugging>
</CONFIG>

+ 460
- 0
backup/avtokanal.lps.bak View File

@@ -0,0 +1,460 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectSession>
<PathDelim Value="\"/>
<Version Value="9"/>
<BuildModes Active="Default"/>
<Units Count="45">
<Unit0>
<Filename Value="avtokanal.lpr"/>
<IsPartOfProject Value="True"/>
<EditorIndex Value="1"/>
<CursorPos X="8" Y="22"/>
<UsageCount Value="86"/>
<Loaded Value="True"/>
</Unit0>
<Unit1>
<Filename Value="unit1.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="Form1"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="Unit1"/>
<IsVisibleTab Value="True"/>
<TopLine Value="228"/>
<CursorPos X="7" Y="335"/>
<FoldState Value=" T3kK098 pj1jT0N012248"/>
<UsageCount Value="86"/>
<Loaded Value="True"/>
<LoadedDesigner Value="True"/>
</Unit1>
<Unit2>
<Filename Value="blcksock.pas"/>
<IsPartOfProject Value="True"/>
<EditorIndex Value="-1"/>
<TopLine Value="3731"/>
<CursorPos Y="3756"/>
<UsageCount Value="36"/>
</Unit2>
<Unit3>
<Filename Value="synsock.pas"/>
<IsPartOfProject Value="True"/>
<EditorIndex Value="-1"/>
<TopLine Value="27"/>
<CursorPos X="6" Y="62"/>
<UsageCount Value="37"/>
</Unit3>
<Unit4>
<Filename Value="httpsend.pas"/>
<IsPartOfProject Value="True"/>
<EditorIndex Value="-1"/>
<TopLine Value="336"/>
<CursorPos Y="351"/>
<UsageCount Value="37"/>
</Unit4>
<Unit5>
<Filename Value="synacode.pas"/>
<IsPartOfProject Value="True"/>
<EditorIndex Value="-1"/>
<TopLine Value="434"/>
<CursorPos Y="475"/>
<UsageCount Value="37"/>
</Unit5>
<Unit6>
<Filename Value="synafpc.pas"/>
<IsPartOfProject Value="True"/>
<EditorIndex Value="-1"/>
<WindowIndex Value="-1"/>
<TopLine Value="-1"/>
<CursorPos X="-1" Y="-1"/>
<UsageCount Value="37"/>
</Unit6>
<Unit7>
<Filename Value="synaip.pas"/>
<IsPartOfProject Value="True"/>
<EditorIndex Value="-1"/>
<TopLine Value="165"/>
<CursorPos Y="189"/>
<UsageCount Value="37"/>
</Unit7>
<Unit8>
<Filename Value="synautil.pas"/>
<IsPartOfProject Value="True"/>
<EditorIndex Value="-1"/>
<TopLine Value="1060"/>
<CursorPos Y="1077"/>
<UsageCount Value="37"/>
</Unit8>
<Unit9>
<Filename Value="synaser.pas"/>
<IsPartOfProject Value="True"/>
<EditorIndex Value="-1"/>
<WindowIndex Value="-1"/>
<TopLine Value="-1"/>
<CursorPos X="-1" Y="-1"/>
<UsageCount Value="37"/>
</Unit9>
<Unit10>
<Filename Value="C:\lazarus\fpc\2.6.4\source\rtl\objpas\sysutils\sysstrh.inc"/>
<CursorPos X="40" Y="27"/>
<UsageCount Value="5"/>
</Unit10>
<Unit11>
<Filename Value="C:\lazarus\components\paslibvlc\PasLibVlcPlayer.pas"/>
<CursorPos X="34" Y="3"/>
<UsageCount Value="5"/>
<DefaultSyntaxHighlighter Value="Delphi"/>
</Unit11>
<Unit12>
<Filename Value="C:\lazarus\components\vlc\reglazvlc.pas"/>
<CursorPos Y="4"/>
<UsageCount Value="5"/>
</Unit12>
<Unit13>
<Filename Value="C:\lazarus\debugger\processdebugger.pp"/>
<TopLine Value="95"/>
<CursorPos X="14" Y="121"/>
<UsageCount Value="5"/>
</Unit13>
<Unit14>
<Filename Value="C:\lazarus\ide\main.pp"/>
<TopLine Value="12954"/>
<CursorPos X="3" Y="12980"/>
<UsageCount Value="5"/>
</Unit14>
<Unit15>
<Filename Value="C:\lazarus\components\lazutils\lazutf8sysutils.pas"/>
<TopLine Value="3"/>
<CursorPos X="45" Y="29"/>
<UsageCount Value="6"/>
</Unit15>
<Unit16>
<Filename Value="C:\lazarus\fpc\2.6.4\source\packages\fcl-process\src\process.pp"/>
<EditorIndex Value="-1"/>
<TopLine Value="4"/>
<CursorPos X="48" Y="24"/>
<UsageCount Value="31"/>
</Unit16>
<Unit17>
<Filename Value="C:\lazarus\components\lazutils\utf8process.pp"/>
<EditorIndex Value="-1"/>
<TopLine Value="35"/>
<CursorPos X="58" Y="57"/>
<UsageCount Value="30"/>
</Unit17>
<Unit18>
<Filename Value="C:\lazarus\synapse\source\lib\sswin32.inc"/>
<EditorIndex Value="-1"/>
<WindowIndex Value="-1"/>
<TopLine Value="-1"/>
<CursorPos X="-1" Y="-1"/>
<UsageCount Value="18"/>
</Unit18>
<Unit19>
<Filename Value="C:\lazarus\lcl\include\messagedialogs.inc"/>
<EditorIndex Value="-1"/>
<TopLine Value="174"/>
<CursorPos Y="201"/>
<UsageCount Value="11"/>
</Unit19>
<Unit20>
<Filename Value="C:\lazarus\components\lazutils\lazlogger.pas"/>
<EditorIndex Value="-1"/>
<TopLine Value="741"/>
<CursorPos Y="784"/>
<UsageCount Value="11"/>
</Unit20>
<Unit21>
<Filename Value="C:\lazarus\lcl\include\lclintf.inc"/>
<EditorIndex Value="-1"/>
<TopLine Value="152"/>
<CursorPos Y="178"/>
<UsageCount Value="11"/>
</Unit21>
<Unit22>
<Filename Value="C:\lazarus\lcl\interfaces\win32\win32lclintf.inc"/>
<EditorIndex Value="-1"/>
<TopLine Value="141"/>
<CursorPos Y="167"/>
<UsageCount Value="11"/>
</Unit22>
<Unit23>
<Filename Value="C:\lazarus\lcl\themes.pas"/>
<EditorIndex Value="-1"/>
<TopLine Value="539"/>
<CursorPos Y="565"/>
<UsageCount Value="11"/>
</Unit23>
<Unit24>
<Filename Value="C:\lazarus\lcl\interfaces\win32\win32object.inc"/>
<EditorIndex Value="-1"/>
<TopLine Value="134"/>
<CursorPos Y="167"/>
<UsageCount Value="11"/>
</Unit24>
<Unit25>
<Filename Value="C:\lazarus\lcl\include\application.inc"/>
<EditorIndex Value="-1"/>
<TopLine Value="1116"/>
<CursorPos Y="1147"/>
<UsageCount Value="11"/>
</Unit25>
<Unit26>
<Filename Value="C:\lazarus\lcl\lclproc.pas"/>
<EditorIndex Value="-1"/>
<TopLine Value="2914"/>
<CursorPos Y="2940"/>
<UsageCount Value="11"/>
</Unit26>
<Unit27>
<Filename Value="C:\lazarus\components\lazutils\lazutf8.pas"/>
<EditorIndex Value="-1"/>
<TopLine Value="3278"/>
<CursorPos Y="3293"/>
<UsageCount Value="11"/>
</Unit27>
<Unit28>
<Filename Value="C:\lazarus\lcl\buttons.pp"/>
<EditorIndex Value="-1"/>
<TopLine Value="490"/>
<CursorPos Y="549"/>
<UsageCount Value="11"/>
</Unit28>
<Unit29>
<Filename Value="C:\lazarus\lcl\interfaces\win32\win32wsdialogs.pp"/>
<EditorIndex Value="-1"/>
<TopLine Value="155"/>
<CursorPos Y="173"/>
<UsageCount Value="11"/>
</Unit29>
<Unit30>
<Filename Value="C:\lazarus\lcl\include\screen.inc"/>
<EditorIndex Value="-1"/>
<TopLine Value="246"/>
<CursorPos Y="274"/>
<UsageCount Value="11"/>
</Unit30>
<Unit31>
<Filename Value="C:\lazarus\lcl\include\wincontrol.inc"/>
<EditorIndex Value="-1"/>
<TopLine Value="7233"/>
<CursorPos Y="7259"/>
<UsageCount Value="11"/>
</Unit31>
<Unit32>
<Filename Value="C:\lazarus\lcl\include\winapi.inc"/>
<EditorIndex Value="-1"/>
<TopLine Value="775"/>
<CursorPos Y="801"/>
<UsageCount Value="11"/>
</Unit32>
<Unit33>
<Filename Value="C:\lazarus\lcl\interfaces\win32\win32winapi.inc"/>
<EditorIndex Value="-1"/>
<TopLine Value="2920"/>
<CursorPos Y="2946"/>
<UsageCount Value="11"/>
</Unit33>
<Unit34>
<Filename Value="C:\lazarus\lcl\grids.pas"/>
<UnitName Value="Grids"/>
<EditorIndex Value="2"/>
<TopLine Value="2343"/>
<CursorPos Y="2370"/>
<UsageCount Value="17"/>
<Loaded Value="True"/>
</Unit34>
<Unit35>
<Filename Value="C:\lazarus\lcl\interfaces\win32\win32proc.pp"/>
<EditorIndex Value="-1"/>
<TopLine Value="1087"/>
<CursorPos Y="1121"/>
<UsageCount Value="9"/>
</Unit35>
<Unit36>
<Filename Value="C:\lazarus\lcl\lresources.pp"/>
<EditorIndex Value="-1"/>
<TopLine Value="1473"/>
<CursorPos Y="1502"/>
<UsageCount Value="9"/>
</Unit36>
<Unit37>
<Filename Value="C:\lazarus\lcl\include\icon.inc"/>
<EditorIndex Value="-1"/>
<TopLine Value="674"/>
<CursorPos Y="700"/>
<UsageCount Value="9"/>
</Unit37>
<Unit38>
<Filename Value="C:\lazarus\lcl\include\rasterimage.inc"/>
<EditorIndex Value="-1"/>
<TopLine Value="147"/>
<CursorPos Y="188"/>
<UsageCount Value="9"/>
</Unit38>
<Unit39>
<Filename Value="C:\lazarus\lcl\include\sharedrasterimage.inc"/>
<EditorIndex Value="-1"/>
<CursorPos Y="49"/>
<UsageCount Value="9"/>
</Unit39>
<Unit40>
<Filename Value="C:\lazarus\lcl\intfgraphics.pas"/>
<EditorIndex Value="-1"/>
<TopLine Value="3411"/>
<CursorPos Y="3437"/>
<UsageCount Value="9"/>
</Unit40>
<Unit41>
<Filename Value="C:\lazarus\lcl\include\graphic.inc"/>
<EditorIndex Value="-1"/>
<TopLine Value="30"/>
<CursorPos Y="56"/>
<UsageCount Value="9"/>
</Unit41>
<Unit42>
<Filename Value="C:\lazarus\lcl\graphtype.pp"/>
<EditorIndex Value="-1"/>
<TopLine Value="1738"/>
<CursorPos Y="1778"/>
<UsageCount Value="9"/>
</Unit42>
<Unit43>
<Filename Value="C:\lazarus\lcl\graphics.pp"/>
<EditorIndex Value="-1"/>
<TopLine Value="2262"/>
<CursorPos Y="2305"/>
<UsageCount Value="9"/>
</Unit43>
<Unit44>
<Filename Value="C:\lazarus\lcl\include\intfbaselcl.inc"/>
<EditorIndex Value="-1"/>
<TopLine Value="298"/>
<CursorPos Y="323"/>
<UsageCount Value="9"/>
</Unit44>
</Units>
<JumpHistory Count="30" HistoryIndex="29">
<Position1>
<Filename Value="unit1.pas"/>
<Caret Line="229" Column="38" TopLine="194"/>
</Position1>
<Position2>
<Filename Value="unit1.pas"/>
<Caret Line="207" Column="16" TopLine="172"/>
</Position2>
<Position3>
<Filename Value="unit1.pas"/>
<Caret Line="68" Column="5" TopLine="26"/>
</Position3>
<Position4>
<Filename Value="unit1.pas"/>
<Caret Line="160" Column="22" TopLine="141"/>
</Position4>
<Position5>
<Filename Value="unit1.pas"/>
<Caret Line="141" Column="25" TopLine="130"/>
</Position5>
<Position6>
<Filename Value="unit1.pas"/>
<Caret Line="135" Column="23" TopLine="110"/>
</Position6>
<Position7>
<Filename Value="unit1.pas"/>
<Caret Line="115" Column="48" TopLine="76"/>
</Position7>
<Position8>
<Filename Value="unit1.pas"/>
<Caret Line="68" Column="52" TopLine="67"/>
</Position8>
<Position9>
<Filename Value="unit1.pas"/>
<Caret Line="283" Column="9" TopLine="258"/>
</Position9>
<Position10>
<Filename Value="unit1.pas"/>
<Caret Line="68" Column="15" TopLine="44"/>
</Position10>
<Position11>
<Filename Value="unit1.pas"/>
<Caret Line="280" Column="70" TopLine="254"/>
</Position11>
<Position12>
<Filename Value="unit1.pas"/>
<Caret Line="283" Column="58" TopLine="258"/>
</Position12>
<Position13>
<Filename Value="unit1.pas"/>
<Caret Line="149" Column="35" TopLine="133"/>
</Position13>
<Position14>
<Filename Value="unit1.pas"/>
<Caret Line="68" Column="59" TopLine="62"/>
</Position14>
<Position15>
<Filename Value="unit1.pas"/>
<Caret Line="285" Column="5" TopLine="284"/>
</Position15>
<Position16>
<Filename Value="unit1.pas"/>
<Caret Line="284" Column="5" TopLine="283"/>
</Position16>
<Position17>
<Filename Value="unit1.pas"/>
<Caret Line="280" Column="22" TopLine="254"/>
</Position17>
<Position18>
<Filename Value="unit1.pas"/>
<Caret Line="354" Column="29" TopLine="15"/>
</Position18>
<Position19>
<Filename Value="unit1.pas"/>
<Caret Line="131" Column="14" TopLine="90"/>
</Position19>
<Position20>
<Filename Value="avtokanal.lpr"/>
<Caret Line="21"/>
</Position20>
<Position21>
<Filename Value="unit1.pas"/>
<Caret Line="143" Column="19" TopLine="132"/>
</Position21>
<Position22>
<Filename Value="unit1.pas"/>
<Caret Line="289" Column="88" TopLine="131"/>
</Position22>
<Position23>
<Filename Value="unit1.pas"/>
<Caret Line="315" TopLine="202"/>
</Position23>
<Position24>
<Filename Value="unit1.pas"/>
<Caret Line="316" Column="32" TopLine="202"/>
</Position24>
<Position25>
<Filename Value="unit1.pas"/>
<Caret Line="318" Column="20" TopLine="202"/>
</Position25>
<Position26>
<Filename Value="unit1.pas"/>
<Caret Line="373" Column="51" TopLine="298"/>
</Position26>
<Position27>
<Filename Value="unit1.pas"/>
<Caret Line="38" Column="19" TopLine="13"/>
</Position27>
<Position28>
<Filename Value="unit1.pas"/>
<Caret Line="56" Column="29" TopLine="13"/>
</Position28>
<Position29>
<Filename Value="unit1.pas"/>
<Caret Line="131" Column="34" TopLine="104"/>
</Position29>
<Position30>
<Filename Value="unit1.pas"/>
<Caret Line="328" Column="18" TopLine="216"/>
</Position30>
</JumpHistory>
</ProjectSession>
</CONFIG>

+ 2512
- 0
backup/unit1.lfm.bak
File diff suppressed because it is too large
View File


+ 405
- 0
backup/unit1.pas.bak View File

@@ -0,0 +1,405 @@
unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, EditBtn,
StdCtrls, LCLProc, Buttons, ExtCtrls, ComCtrls, Grids, UTF8Process, process,
ShellApi, httpsend;
type
TPlayThread = class(TThread)
private
fBusy: boolean;
fIdx: integer;
fTimeStamp: string;
fTimeStampShow: boolean;
procedure Hint;
procedure Busy;
procedure Play;
procedure CheckBusy;
procedure ThreadTerminate;
procedure DownloadMessage;
protected
procedure Execute; override;
public
constructor Create(CreateSuspended: boolean);
end;
type
{ TForm1 }
TForm1 = class(TForm)
btnSave: TButton;
chkAlwaysOnTop: TCheckBox;
chkAutoRefresh: TCheckBox;
chkAutoPlay: TCheckBox;
DateEdit1: TDateEdit;
Image1: TImage;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
SaveDialog1: TSaveDialog;
btnRefresh: TSpeedButton;
btnToday: TSpeedButton;
StatusBar1: TStatusBar;
StringGrid1: TStringGrid;
Timer1: TTimer;
TrayIcon1: TTrayIcon;
procedure btnSaveClick(Sender: TObject);
procedure chkAlwaysOnTopChange(Sender: TObject);
procedure chkAutoRefreshChange(Sender: TObject);
procedure DateEdit1Change(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure btnRefreshClick(Sender: TObject);
procedure btnTodayClick(Sender: TObject);
procedure FormWindowStateChange(Sender: TObject);
procedure StringGrid1DblClick(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure TrayIcon1DblClick(Sender: TObject);
procedure UpdateMessages(date: string);
procedure DownloadMessage(fIdx: integer; fName: string);
private
{ private declarations }
public
{ public declarations }
end;
var
Form1: TForm1;
count_prev, count_current: integer;
PlayQueue: integer;
PlayBusy: boolean;
PlayThread: TPlayThread;
PlayList: TStringList;
implementation
{$R *.lfm}
{ TForm1 }
procedure TForm1.UpdateMessages(date: string);
var
url: string;
csv: TStringList;
begin
url := 'http://avto.opentomsk.net/archive.php?date='; //2015-02-27
csv := TStringList.Create;
with THTTPSend.Create do
begin
if HTTPMethod('GET', url + date) then
try
csv.LoadFromStream(Document);
csv.Text := StringReplace(csv.Text, '''', '', [rfReplaceAll]);
csv.SaveToFile(GetTempDir(False) + 'playlist.csv');
if not Assigned(PlayList) then
PlayList := TStringList.Create;
count_prev := count_current;
PlayList.Clear;
PlayList.LoadFromFile(GetTempDir(False) + 'playlist.csv');
StringGrid1.Clean;
StringGrid1.RowCount := 0;
StringGrid1.LoadFromCSVFile(GetTempDir(False) + 'playlist.csv');
StringGrid1.InsertRowWithValues(0, ['Дата', 'Время', 'Длит', 'Путь']);
StringGrid1.DeleteCol(0);
StringGrid1.DeleteCol(2);
StringGrid1.Row := 0;
count_current := PlayList.Count;
Label5.Caption := IntToStr(PlayList.Count);
StatusBar1.Panels[0].Text := TimeToStr(now()) + ' Скачан список файлов';
except
//Application.MessageBox('Ошибка при скачивании списка воспроизведения','Error', 0);
end;
Free;
end;
csv.Free;
if PlayList.Count > 0 then
begin
btnSave.Enabled := True;
end
else
begin
btnSave.Enabled := False;
end;
if chkAutoRefresh.Checked then DateEdit1.text:=FormatDateTime('DD.MM.YYYY',Now);
if (DateToStr(DateEdit1.Date) = DateToStr(Now) ) then
begin
btnRefresh.Enabled := True;
chkAutoRefresh.Enabled := True;
//chkAutoRefresh.Checked := False;
//chkAutoPlay.Enabled := False;
//chkAutoPlay.Checked := False;
end
else
begin
btnRefresh.Enabled := False;
chkAutoRefresh.Enabled := False;
chkAutoRefresh.Checked := False;
chkAutoPlay.Enabled := False;
chkAutoPlay.Checked := False;
end;
end;
function get_value(item, Value: integer): string;
var
params: TStringList;
begin
params := TStringList.Create;
params.Delimiter := ',';
params.DelimitedText := PlayList[item - 1];
Result := params[Value];
params.Free;
end;
procedure TForm1.DownloadMessage(fIdx: integer; fName: string);
var
url, path: string;
memstream: TMemoryStream;
begin
url := 'http://avto.opentomsk.net/archive/';
path := get_value(fIdx, 3);
with THTTPSend.Create do
begin
if HTTPMethod('GET', url + path) then
try
memstream := TMemoryStream.Create;
memstream := Document;
memstream.SaveToFile(UTF8ToSys(fName));
memstream.Free;
except
Application.MessageBox('Ошибка при скачивании файла', 'Error', 0);
end;
end;
end;
procedure TPlayThread.DownloadMessage();
var
url, path: string;
memstream: TMemoryStream;
begin
url := 'http://avto.opentomsk.net/archive/';
path := get_value(fIdx, 3);
with THTTPSend.Create do
begin
if HTTPMethod('GET', url + path) then
try
memstream := TMemoryStream.Create;
memstream := Document;
memstream.SaveToFile(SysToUTF8(GetTempDir(False) + 'ak47.mp3'));
memstream.Free;
except
Application.MessageBox('Ошибка при скачивании файла', 'Error', 0);
end;
end;
end;
constructor TPlayThread.Create(CreateSuspended: boolean);
begin
FreeOnTerminate := True;
inherited Create(CreateSuspended);
Inc(PlayQueue);
end;
procedure TPlayThread.ThreadTerminate;
begin
Dec(PlayQueue);
end;
procedure TplayThread.Busy;
begin
if fBusy = True then
begin
PlayBusy := True;
end
else
begin
PlayBusy := False;
end;
end;
procedure TPlayThread.CheckBusy;
begin
if PlayBusy = True then
begin
fBusy := True;
end
else
begin
fBusy := False;
end;
end;
procedure TPlayThread.Hint;
begin
Form1.TrayIcon1.BalloonHint := fTimeStamp;
Form1.TrayIcon1.ShowBalloonHint;
end;
procedure TPlayThread.Execute;
begin
Synchronize(@CheckBusy);
while (not Terminated) and (fBusy = True) do
begin
sleep(2000);
Synchronize(@CheckBusy);
end;
fBusy := True;
Synchronize(@Busy);
if fTimeStampShow then
Synchronize(@Hint);
Play();
fBusy := False;
Synchronize(@Busy);
Synchronize(@ThreadTerminate);
Terminate;
end;
procedure TPlayThread.play();
var
tmp: ansistring;
Player: TProcessUTF8;
PlayerPath: ansistring;
PlayerParams: ansistring;
begin
tmp := GetTempDir(False) + 'ak47.mp3';
Synchronize(@DownloadMessage);
PlayerPath := SysToUTF8(ExtractFileDir(Application.ExeName) + '\mpg123.exe');
PlayerParams := SysToUTF8(' -q "' + tmp + '"');
ShowMessage('http://avto.opentomsk.net/archive/'+get_value(fIdx, 3));
Player := TProcessUTF8.Create(nil);
Form1.StatusBar1.Panels.Items[0].Text := 'Играет запись от ' + fTimeStamp;
Form1.StatusBar1.Panels.Items[1].Text := 'В очереди ' + IntToStr(PlayQueue);
try
Player.CommandLine := PlayerPath + ' ' + PlayerParams;
Player.Options := Player.Options + [poNoConsole, poWaitOnExit];
Player.Execute;
finally
Player.Free;
end;
Form1.StatusBar1.Panels.Items[0].Text := '';
Form1.StatusBar1.Panels.Items[1].Text := '';
end;
procedure TForm1.DateEdit1Change(Sender: TObject);
begin
try
UpdateMessages(FormatDateTime('YYYY-MM-DD', DateEdit1.Date));
except
end;
end;
procedure TForm1.btnSaveClick(Sender: TObject);
begin
SaveDialog1.FileName := StringReplace(get_value(StringGrid1.Row, 0) +
' ' + get_value(StringGrid1.Row, 1), ':', '_', [rfReplaceAll]);
if SaveDialog1.Execute then
begin
DownloadMessage(StringGrid1.Row, SaveDialog1.FileName);
end;
end;
procedure TForm1.chkAlwaysOnTopChange(Sender: TObject);
begin
if chkAlwaysOnTop.Checked then
Form1.FormStyle := fsSystemStayOnTop
else
Form1.FormStyle := fsNormal;
end;
procedure TForm1.chkAutoRefreshChange(Sender: TObject);
begin
if chkAutoRefresh.Checked then
chkAutoPlay.Enabled := True
else
chkAutoPlay.Enabled := False;
end;
procedure TForm1.FormShow(Sender: TObject);
var v:TStringList;
begin
try
v:=TStringList.Create;
DateEdit1.Date := now();
UpdateMessages(FormatDateTime('YYYY-MM-DD', DateEdit1.Date));
v.LoadFromFile('version');
Label3.Caption:='Версия '+ v.Text;
v.Free;
except
//
end;
end;
procedure TForm1.FormWindowStateChange(Sender: TObject);
begin
if Form1.WindowState = wsMinimized then
begin
form1.WindowState := wsNormal;
form1.Hide;
Form1.ShowInTaskBar := stNever;
Form1.TrayIcon1.BalloonHint :=
'Программа все еще запущена. Чтобы отключить вместо сворачивания закройте её.';
Form1.TrayIcon1.ShowBalloonHint;
end;
end;
procedure TForm1.StringGrid1DblClick(Sender: TObject);
begin
PlayThread := TPlayThread.Create(True);
PlayThread.fIdx := StringGrid1.row;
PlayThread.fTimeStamp := get_value(StringGrid1.row, 1);
PlayThread.fTimeStampShow := True;
PlayThread.Resume;
end;
procedure TForm1.TrayIcon1DblClick(Sender: TObject);
begin
Form1.Show;
end;
procedure TForm1.btnRefreshClick(Sender: TObject);
begin
UpdateMessages(FormatDateTime('YYYY-MM-DD', DateEdit1.Date));
count_current := PlayList.Count;
count_prev := count_current;
end;
procedure TForm1.btnTodayClick(Sender: TObject);
begin
DateEdit1.Date := now();
end;
procedure TForm1.Timer1Timer(Sender: TObject);
var
p, raznica: integer;
begin
if ((chkAutoRefresh.Checked) and (chkAutoRefresh.Enabled)) then
begin
Timer1.Enabled := False;
UpdateMessages(FormatDateTime( 'YYYY-MM-DD', Now ));
DateEdit1.Date:=Now;
raznica := count_current - count_prev;
if ((count_current > count_prev) and (chkAutoPlay.Checked) and
(chkAutoPlay.Enabled)) then
begin
for p := 0 to raznica - 1 do
begin
PlayThread := TPlayThread.Create(True);
PlayThread.fIdx := count_current - count_prev - p;
PlayThread.fTimeStamp := get_value(count_current - count_prev - p, 1);
PlayThread.fTimeStampShow := True;
PlayThread.Resume;
end;
end;
Timer1.Enabled := True;
end;
end;
end.

+ 4333
- 0
blcksock.pas
File diff suppressed because it is too large
View File


+ 845
- 0
httpsend.pas View File

@@ -0,0 +1,845 @@
{==============================================================================|
| Project : Ararat Synapse | 003.012.006 |
|==============================================================================|
| Content: HTTP client |
|==============================================================================|
| Copyright (c)1999-2011, Lukas Gebauer |
| All rights reserved. |
| |
| Redistribution and use in source and binary forms, with or without |
| modification, are permitted provided that the following conditions are met: |
| |
| Redistributions of source code must retain the above copyright notice, this |
| list of conditions and the following disclaimer. |
| |
| Redistributions in binary form must reproduce the above copyright notice, |
| this list of conditions and the following disclaimer in the documentation |
| and/or other materials provided with the distribution. |
| |
| Neither the name of Lukas Gebauer nor the names of its contributors may |
| be used to endorse or promote products derived from this software without |
| specific prior written permission. |
| |
| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" |
| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE |
| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE |
| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR |
| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL |
| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR |
| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER |
| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT |
| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY |
| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH |
| DAMAGE. |
|==============================================================================|
| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
| Portions created by Lukas Gebauer are Copyright (c) 1999-2011. |
| All Rights Reserved. |
|==============================================================================|
| Contributor(s): |
|==============================================================================|
| History: see HISTORY.HTM from distribution package |
| (Found at URL: http://www.ararat.cz/synapse/) |
|==============================================================================}
{:@abstract(HTTP protocol client)
Used RFC: RFC-1867, RFC-1947, RFC-2388, RFC-2616
}
{$IFDEF FPC}
{$MODE DELPHI}
{$ENDIF}
{$H+}
//old Delphi does not have MSWINDOWS define.
{$IFDEF WIN32}
{$IFNDEF MSWINDOWS}
{$DEFINE MSWINDOWS}
{$ENDIF}
{$ENDIF}
{$IFDEF UNICODE}
{$WARN IMPLICIT_STRING_CAST OFF}
{$WARN IMPLICIT_STRING_CAST_LOSS OFF}
{$ENDIF}
unit httpsend;
interface
uses
SysUtils, Classes,
blcksock, synautil, synaip, synacode, synsock;
const
cHttpProtocol = '80';
type
{:These encoding types are used internally by the THTTPSend object to identify
the transfer data types.}
TTransferEncoding = (TE_UNKNOWN, TE_IDENTITY, TE_CHUNKED);
{:abstract(Implementation of HTTP protocol.)}
THTTPSend = class(TSynaClient)
protected
FSock: TTCPBlockSocket;
FTransferEncoding: TTransferEncoding;
FAliveHost: string;
FAlivePort: string;
FHeaders: TStringList;
FDocument: TMemoryStream;
FMimeType: string;
FProtocol: string;
FKeepAlive: Boolean;
FKeepAliveTimeout: integer;
FStatus100: Boolean;
FProxyHost: string;
FProxyPort: string;
FProxyUser: string;
FProxyPass: string;
FResultCode: Integer;
FResultString: string;
FUserAgent: string;
FCookies: TStringList;
FDownloadSize: integer;
FUploadSize: integer;
FRangeStart: integer;
FRangeEnd: integer;
FAddPortNumberToHost: Boolean;
function ReadUnknown: Boolean;
function ReadIdentity(Size: Integer): Boolean;
function ReadChunked: Boolean;
procedure ParseCookies;
function PrepareHeaders: AnsiString;
function InternalDoConnect(needssl: Boolean): Boolean;
function InternalConnect(needssl: Boolean): Boolean;
public
constructor Create;
destructor Destroy; override;
{:Reset headers and document and Mimetype.}
procedure Clear;
{:Decode ResultCode and ResultString from Value.}
procedure DecodeStatus(const Value: string);
{:Connects to host define in URL and access to resource defined in URL by
method. If Document is not empty, send it to server as part of HTTP request.
Server response is in Document and headers. Connection may be authorised
by username and password in URL. If you define proxy properties, connection
is made by this proxy. If all OK, result is @true, else result is @false.
If you use in URL 'https:' instead only 'http:', then your request is made
by SSL/TLS connection (if you not specify port, then port 443 is used
instead standard port 80). If you use SSL/TLS request and you have defined
HTTP proxy, then HTTP-tunnel mode is automaticly used .}
function HTTPMethod(const Method, URL: string): Boolean;
{:You can call this method from OnStatus event for break current data
transfer. (or from another thread.)}
procedure Abort;
published
{:Before HTTP operation you may define any non-standard headers for HTTP
request, except of: 'Expect: 100-continue', 'Content-Length', 'Content-Type',
'Connection', 'Authorization', 'Proxy-Authorization' and 'Host' headers.
After HTTP operation contains full headers of returned document.}
property Headers: TStringList read FHeaders;
{:This is stringlist with name-value stringlist pairs. Each this pair is one
cookie. After HTTP request is returned cookies parsed to this stringlist.
You can leave this cookies untouched for next HTTP request. You can also
save this stringlist for later use.}
property Cookies: TStringList read FCookies;
{:Stream with document to send (before request, or with document received
from HTTP server (after request).}
property Document: TMemoryStream read FDocument;
{:If you need download only part of requested document, here specify
possition of subpart begin. If here 0, then is requested full document.}
property RangeStart: integer read FRangeStart Write FRangeStart;
{:If you need download only part of requested document, here specify
possition of subpart end. If here 0, then is requested document from
rangeStart to end of document. (for broken download restoration,
for example.)}
property RangeEnd: integer read FRangeEnd Write FRangeEnd;
{:Mime type of sending data. Default is: 'text/html'.}
property MimeType: string read FMimeType Write FMimeType;
{:Define protocol version. Possible values are: '1.1', '1.0' (default)
and '0.9'.}
property Protocol: string read FProtocol Write FProtocol;
{:If @true (default value), keepalives in HTTP protocol 1.1 is enabled.}
property KeepAlive: Boolean read FKeepAlive Write FKeepAlive;
{:Define timeout for keepalives in seconds!}
property KeepAliveTimeout: integer read FKeepAliveTimeout Write FKeepAliveTimeout;
{:if @true, then server is requested for 100status capability when uploading
data. Default is @false (off).}
property Status100: Boolean read FStatus100 Write FStatus100;
{:Address of proxy server (IP address or domain name) where you want to
connect in @link(HTTPMethod) method.}
property ProxyHost: string read FProxyHost Write FProxyHost;
{:Port number for proxy connection. Default value is 8080.}
property ProxyPort: string read FProxyPort Write FProxyPort;
{:Username for connect to proxy server where you want to connect in
HTTPMethod method.}
property ProxyUser: string read FProxyUser Write FProxyUser;
{:Password for connect to proxy server where you want to connect in
HTTPMethod method.}
property ProxyPass: string read FProxyPass Write FProxyPass;
{:Here you can specify custom User-Agent indentification. By default is
used: 'Mozilla/4.0 (compatible; Synapse)'}
property UserAgent: string read FUserAgent Write FUserAgent;
{:After successful @link(HTTPMethod) method contains result code of
operation.}
property ResultCode: Integer read FResultCode;
{:After successful @link(HTTPMethod) method contains string after result code.}
property ResultString: string read FResultString;
{:if this value is not 0, then data download pending. In this case you have
here total sice of downloaded data. It is good for draw download
progressbar from OnStatus event.}
property DownloadSize: integer read FDownloadSize;
{:if this value is not 0, then data upload pending. In this case you have
here total sice of uploaded data. It is good for draw upload progressbar
from OnStatus event.}
property UploadSize: integer read FUploadSize;
{:Socket object used for TCP/IP operation. Good for seting OnStatus hook, etc.}
property Sock: TTCPBlockSocket read FSock;
{:To have possibility to switch off port number in 'Host:' HTTP header, by
default @TRUE. Some buggy servers not like port informations in this header.}
property AddPortNumberToHost: Boolean read FAddPortNumberToHost write FAddPortNumberToHost;
end;
{:A very usefull function, and example of use can be found in the THTTPSend
object. It implements the GET method of the HTTP protocol. This function sends
the GET method for URL document to an HTTP server. Returned document is in the
"Response" stringlist (without any headers). Returns boolean TRUE if all went
well.}
function HttpGetText(const URL: string; const Response: TStrings): Boolean;
{:A very usefull function, and example of use can be found in the THTTPSend
object. It implements the GET method of the HTTP protocol. This function sends
the GET method for URL document to an HTTP server. Returned document is in the
"Response" stream. Returns boolean TRUE if all went well.}
function HttpGetBinary(const URL: string; const Response: TStream): Boolean;
{:A very useful function, and example of use can be found in the THTTPSend
object. It implements the POST method of the HTTP protocol. This function sends
the SEND method for a URL document to an HTTP server. The document to be sent
is located in "Data" stream. The returned document is in the "Data" stream.
Returns boolean TRUE if all went well.}
function HttpPostBinary(const URL: string; const Data: TStream): Boolean;
{:A very useful function, and example of use can be found in the THTTPSend
object. It implements the POST method of the HTTP protocol. This function is
good for POSTing form data. It sends the POST method for a URL document to
an HTTP server. You must prepare the form data in the same manner as you would
the URL data, and pass this prepared data to "URLdata". The following is
a sample of how the data would appear: 'name=Lukas&field1=some%20data'.
The information in the field must be encoded by EncodeURLElement function.
The returned document is in the "Data" stream. Returns boolean TRUE if all
went well.}
function HttpPostURL(const URL, URLData: string; const Data: TStream): Boolean;
{:A very useful function, and example of use can be found in the THTTPSend
object. It implements the POST method of the HTTP protocol. This function sends
the POST method for a URL document to an HTTP server. This function simulate
posting of file by HTML form used method 'multipart/form-data'. Posting file
is in DATA stream. Its name is Filename string. Fieldname is for name of
formular field with file. (simulate HTML INPUT FILE) The returned document is
in the ResultData Stringlist. Returns boolean TRUE if all went well.}
function HttpPostFile(const URL, FieldName, FileName: string;
const Data: TStream; const ResultData: TStrings): Boolean;
implementation
constructor THTTPSend.Create;
begin
inherited Create;
FHeaders := TStringList.Create;
FCookies := TStringList.Create;
FDocument := TMemoryStream.Create;
FSock := TTCPBlockSocket.Create;
FSock.Owner := self;
FSock.ConvertLineEnd := True;
FSock.SizeRecvBuffer := c64k;
FSock.SizeSendBuffer := c64k;
FTimeout := 90000;
FTargetPort := cHttpProtocol;
FProxyHost := '';
FProxyPort := '8080';
FProxyUser := '';
FProxyPass := '';
FAliveHost := '';
FAlivePort := '';
FProtocol := '1.0';
FKeepAlive := True;
FStatus100 := False;
FUserAgent := 'Mozilla/4.0 (compatible; Synapse)';
FDownloadSize := 0;
FUploadSize := 0;
FAddPortNumberToHost := true;
FKeepAliveTimeout := 300;
Clear;
end;
destructor THTTPSend.Destroy;
begin
FSock.Free;
FDocument.Free;
FCookies.Free;
FHeaders.Free;
inherited Destroy;
end;
procedure THTTPSend.Clear;
begin
FRangeStart := 0;
FRangeEnd := 0;
FDocument.Clear;
FHeaders.Clear;
FMimeType := 'text/html';
end;
procedure THTTPSend.DecodeStatus(const Value: string);
var
s, su: string;
begin
s := Trim(SeparateRight(Value, ' '));
su := Trim(SeparateLeft(s, ' '));
FResultCode := StrToIntDef(su, 0);
FResultString := Trim(SeparateRight(s, ' '));
if FResultString = s then
FResultString := '';
end;
function THTTPSend.PrepareHeaders: AnsiString;
begin
if FProtocol = '0.9' then
Result := FHeaders[0] + CRLF
else
{$IFNDEF MSWINDOWS}
Result := {$IFDEF UNICODE}AnsiString{$ENDIF}(AdjustLineBreaks(FHeaders.Text, tlbsCRLF));
{$ELSE}
Result := FHeaders.Text;
{$ENDIF}
end;
function THTTPSend.InternalDoConnect(needssl: Boolean): Boolean;
begin
Result := False;
FSock.CloseSocket;
FSock.Bind(FIPInterface, cAnyPort);
if FSock.LastError <> 0 then
Exit;
FSock.Connect(FTargetHost, FTargetPort);
if FSock.LastError <> 0 then
Exit;
if needssl then
begin
if (FSock.SSL.SNIHost='') then
FSock.SSL.SNIHost:=FTargetHost;
FSock.SSLDoConnect;
FSock.SSL.SNIHost:=''; //don't need it anymore and don't wan't to reuse it in next connection
if FSock.LastError <> 0 then
Exit;
end;
FAliveHost := FTargetHost;
FAlivePort := FTargetPort;
Result := True;
end;
function THTTPSend.InternalConnect(needssl: Boolean): Boolean;
begin
if FSock.Socket = INVALID_SOCKET then
Result := InternalDoConnect(needssl)
else
if (FAliveHost <> FTargetHost) or (FAlivePort <> FTargetPort)
or FSock.CanRead(0) then
Result := InternalDoConnect(needssl)
else
Result := True;
end;
function THTTPSend.HTTPMethod(const Method, URL: string): Boolean;
var
Sending, Receiving: Boolean;
status100: Boolean;
status100error: string;
ToClose: Boolean;
Size: Integer;
Prot, User, Pass, Host, Port, Path, Para, URI: string;
s, su: AnsiString;
HttpTunnel: Boolean;
n: integer;
pp: string;
UsingProxy: boolean;
l: TStringList;
x: integer;
begin
{initial values}
Result := False;
FResultCode := 500;
FResultString := '';
FDownloadSize := 0;
FUploadSize := 0;
URI := ParseURL(URL, Prot, User, Pass, Host, Port, Path, Para);
User := DecodeURL(user);
Pass := DecodeURL(pass);
if User = '' then
begin
User := FUsername;
Pass := FPassword;
end;
if UpperCase(Prot) = 'HTTPS' then
begin
HttpTunnel := FProxyHost <> '';
FSock.HTTPTunnelIP := FProxyHost;
FSock.HTTPTunnelPort := FProxyPort;
FSock.HTTPTunnelUser := FProxyUser;
FSock.HTTPTunnelPass := FProxyPass;
end
else
begin
HttpTunnel := False;
FSock.HTTPTunnelIP := '';
FSock.HTTPTunnelPort := '';
FSock.HTTPTunnelUser := '';
FSock.HTTPTunnelPass := '';
end;
UsingProxy := (FProxyHost <> '') and not(HttpTunnel);
Sending := FDocument.Size > 0;
{Headers for Sending data}
status100 := FStatus100 and Sending and (FProtocol = '1.1');
if status100 then
FHeaders.Insert(0, 'Expect: 100-continue');
if Sending then
begin
FHeaders.Insert(0, 'Content-Length: ' + IntToStr(FDocument.Size));
if FMimeType <> '' then
FHeaders.Insert(0, 'Content-Type: ' + FMimeType);
end;
{ setting User-agent }
if FUserAgent <> '' then
FHeaders.Insert(0, 'User-Agent: ' + FUserAgent);
{ setting Ranges }
if (FRangeStart > 0) or (FRangeEnd > 0) then
begin
if FRangeEnd >= FRangeStart then
FHeaders.Insert(0, 'Range: bytes=' + IntToStr(FRangeStart) + '-' + IntToStr(FRangeEnd))
else
FHeaders.Insert(0, 'Range: bytes=' + IntToStr(FRangeStart) + '-');
end;
{ setting Cookies }
s := '';
for n := 0 to FCookies.Count - 1 do
begin
if s <> '' then
s := s + '; ';
s := s + FCookies[n];
end;
if s <> '' then
FHeaders.Insert(0, 'Cookie: ' + s);
{ setting KeepAlives }
pp := '';
if UsingProxy then
pp := 'Proxy-';
if FKeepAlive then
begin
FHeaders.Insert(0, pp + 'Connection: keep-alive');
FHeaders.Insert(0, 'Keep-Alive: ' + IntToStr(FKeepAliveTimeout));
end