/programy/delphi/download/Download Manager 0.0.1.2/Clanek.url |
---|
0,0 → 1,2 |
[InternetShortcut] |
URL=http://gds.oceany.cz/index.php?clanek= |
/programy/delphi/download/Download Manager 0.0.1.2/DOWNLOAD.DPR |
---|
0,0 → 1,15 |
program download; |
uses |
Forms, |
Downloader in 'Downloader.pas' {Form1}, |
SaveDialog in 'SaveDialog.pas' {Form2}; |
{$R *.RES} |
begin |
Application.Initialize; |
Application.CreateForm(TForm1, Form1); |
Application.CreateForm(TForm2, Form2); |
Application.Run; |
end. |
/programy/delphi/download/Download Manager 0.0.1.2/DOWNLOAD.RES |
---|
Cannot display: file marked as a binary type. |
svn:mime-type = application/octet-stream |
Property changes: |
Added: svn:mime-type |
+application/octet-stream |
\ No newline at end of property |
/programy/delphi/download/Download Manager 0.0.1.2/DOWNLOAD.dof |
---|
0,0 → 1,75 |
[Compiler] |
A=1 |
B=0 |
C=1 |
D=1 |
E=0 |
F=0 |
G=1 |
H=1 |
I=1 |
J=1 |
K=0 |
L=1 |
M=0 |
N=1 |
O=1 |
P=1 |
Q=0 |
R=0 |
S=0 |
T=0 |
U=0 |
V=1 |
W=0 |
X=1 |
Y=0 |
Z=1 |
ShowHints=1 |
ShowWarnings=1 |
UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; |
[Linker] |
MapFile=0 |
OutputObjs=0 |
ConsoleApp=1 |
DebugInfo=0 |
MinStackSize=16384 |
MaxStackSize=1048576 |
ImageBase=4194304 |
ExeDescription= |
[Directories] |
OutputDir= |
UnitOutputDir= |
SearchPath= |
Packages=vclx30;VCL30;vcldb30;vcldbx30;inetdb30;inet30;VclSmp30;Qrpt30;teeui30;teedb30;tee30;dss30;IBEVNT30 |
Conditionals= |
DebugSourceDirs= |
UsePackages=0 |
[Parameters] |
RunParams= |
HostApplication= |
[Version Info] |
IncludeVerInfo=1 |
AutoIncBuild=0 |
MajorVer=0 |
MinorVer=0 |
Release=1 |
Build=1 |
Debug=0 |
PreRelease=0 |
Special=0 |
Private=0 |
DLL=0 |
Locale=1029 |
CodePage=1250 |
[Version Info Keys] |
CompanyName=GAME Developer |
FileDescription= |
FileVersion=0.0.1.1 |
InternalName= |
LegalCopyright=Roman Schulz |
LegalTrademarks=Roman Schulz |
OriginalFilename=Downloader.exe |
ProductName=Download Manager |
ProductVersion=1.0.0.0 |
Comments=Tento program je freeware. Pùvodnì byl urèen pro soukromé pouití, pro jeho úspìnost byl uvolnìn jako freeware. Více informací, zdrojové kódy a popis programu najdete na http://gds.oceany.cz |
/programy/delphi/download/Download Manager 0.0.1.2/Diskuse.url |
---|
0,0 → 1,2 |
[InternetShortcut] |
URL=http://gds.oceany.cz/forum.php?clanek= |
/programy/delphi/download/Download Manager 0.0.1.2/Downloader.dcu |
---|
Cannot display: file marked as a binary type. |
svn:mime-type = application/octet-stream |
Property changes: |
Added: svn:mime-type |
+application/octet-stream |
\ No newline at end of property |
/programy/delphi/download/Download Manager 0.0.1.2/Downloader.dfm |
---|
Cannot display: file marked as a binary type. |
svn:mime-type = application/octet-stream |
Property changes: |
Added: svn:mime-type |
+application/octet-stream |
\ No newline at end of property |
/programy/delphi/download/Download Manager 0.0.1.2/Downloader.pas |
---|
0,0 → 1,493 |
// ****************************************************************************** |
// This source has been created by Roman Schulz, 2002. |
// Visit my web-site at http://gds.oceany.cz for more info |
// ****************************************************************************** |
unit Downloader; |
interface |
uses |
Windows, ShellAPI, Messages, SysUtils, Graphics, Forms, Dialogs, Classes, |
StdCtrls, isp3, Menus, INIFiles, OleCtrls, Controls, FileCtrl, Registry, |
ComObj, ActiveX, ShlObj, ComCtrls, ExtCtrls, Gauges; |
const |
WM_TRAYAPPNOTIFY = WM_USER; // vlastní identifikátor zprávy |
type |
TForm1 = class(TForm) |
Edit1: TEdit; |
ListBox1: TListBox; |
Button1: TButton; |
Button2: TButton; |
Label1: TLabel; |
MainMenu1: TMainMenu; |
File1: TMenuItem; |
Exit1: TMenuItem; |
Help1: TMenuItem; |
About1: TMenuItem; |
SearchforHelpOn1: TMenuItem; |
Reset1: TMenuItem; |
AutoSave1: TMenuItem; |
Zobrazen1: TMenuItem; |
dn1: TMenuItem; |
PopupMenu1: TPopupMenu; |
Konec1: TMenuItem; |
Zobrazit1: TMenuItem; |
Trayicon1: TMenuItem; |
Skrtformul1: TMenuItem; |
Skrtformul2: TMenuItem; |
Download1: TMenuItem; |
Hledatnainternetu1: TMenuItem; |
Button3: TButton; |
PidatdoSTARTmenu1: TMenuItem; |
Pidatnaplochu1: TMenuItem; |
StatusBar1: TStatusBar; |
Timer1: TTimer; |
Gauge1: TGauge; |
Vceoaplikaci1: TMenuItem; |
procedure Edit1KeyDown(Sender: TObject; var Key: Word; |
Shift: TShiftState); |
procedure Button2Click(Sender: TObject); |
procedure HTTP1StateChanged(Sender: TObject; State: Smallint); |
procedure Button1Click(Sender: TObject); |
procedure ListBox1Click(Sender: TObject); |
procedure AutoSave1Click(Sender: TObject); |
procedure Exit1Click(Sender: TObject); |
procedure FormClose(Sender: TObject; var Action: TCloseAction); |
procedure SearchforHelpOn1Click(Sender: TObject); |
procedure dn1Click(Sender: TObject); |
procedure ZkratkyVypnuty; |
procedure ZkratkyZapnuty; |
procedure FormDestroy(Sender: TObject); |
procedure Trayicon1Click(Sender: TObject); |
procedure Zobrazit1Click(Sender: TObject); |
procedure Skrtformul1Click(Sender: TObject); |
procedure About1Click(Sender: TObject); |
procedure CreateLink(WorkingDirectory,FileName,Arguments: String;TargetLinkFile: WideString; |
Description,IconPath: String;IconIdex: Integer); |
procedure AddToStart(Sender: TObject); |
procedure AddToDesktop(Sender: TObject); |
procedure Timer1Timer(Sender: TObject); |
procedure HTTP1Error(Sender: TObject; Number: Smallint; |
var Description: WideString; Scode: Integer; const Source, |
HelpFile: WideString; HelpContext: Integer; |
var CancelDisplay: WordBool); |
private |
Download_file, Zobrazeni: String; |
Busy: boolean; |
Settings: TINIFile; |
NotifyIconData: TNotifyIconData; // data pro ikonu |
Time: Dword; |
Sekund, BytesTransferredLast: Integer; |
procedure WMTrayAppNotify(var M: TMessage); message WM_TRAYAPPNOTIFY; |
public |
Destination: String; |
protected |
procedure WMHotKey(var Message: TMessage); message WM_HOTKEY; |
end; |
var |
Form1: TForm1; |
implementation |
uses SaveDialog; |
{$R *.DFM} |
// ****************************************************************************** |
// Rutiny download manageru |
// ****************************************************************************** |
//Reset |
procedure TForm1.Button1Click(Sender: TObject); |
var i, dummy: integer; |
//param: DWord; |
begin |
//Monost vypnutí vekerých klávesových zkratek ve Win9x |
//Param := 0; |
//SystemParametersInfo(SPI_SETFASTTASKSWITCH, UINT(not false), @Param, 0); |
// ALT+TAB, CTRL+ESC |
//SystemParametersInfo(SPI_SCREENSAVERRUNNING, UINT(not false), @Param, 0); |
// CTRL+ALT+DEL |
//Vlozi zacatek internetove adresy |
Edit1.text := 'http://'; |
//Stornujeme stahování |
if HTTP1.Busy then HTTP1.Cancel; |
Busy := false; |
Label1.caption := 'Pøipraven na stahování'; |
//Skrytí task baru |
ShowWindow(Application.Handle, SW_HIDE); //schová aplikaci z taskbaru |
//Nacteni hodnot z konfiguracniho souboru |
Settings:=TIniFile.Create((ExtractFilePath(Application.ExeName))+'settings.cfg'); |
//Nacteni cile ukládání |
Destination := Settings.ReadString('Options','Destination',ExtractFilePath(Application.ExeName)); |
//Kde se ma zobrazit ikonka |
Zobrazeni := Settings.ReadString('Options','Zobrazeni','TRAY_ICON'); |
if Zobrazeni = 'TRAY_ICON' then Trayicon1Click(Sender) |
else if Zobrazeni = 'NONE' then dn1Click(Sender) |
else Trayicon1Click(Sender); |
//Vymazani celeho mema |
for i:=1 to ListBox1.Items.Count do ListBox1.Items.Delete(0); |
end; |
//Stahuj |
procedure TForm1.Button2Click(Sender: TObject); |
var i:integer; |
FileName:string; |
begin |
if (ListBox1.Items.Count <> 0) then |
if (Busy = false) then begin |
Download_file := ListBox1.Items.Strings[0]; |
//Ziskani jmena souboru z internetove adresy |
for i:=0 to Length(Download_file) do |
if (Download_file[i]<>'/') then FileName := FileName + Download_file[i] |
else FileName:=''; |
//Stavový label |
Label1.caption:='Stahování souboru: '+Download_file; |
Time := GetTickCount; |
HTTP1.GetDoc(Download_file, '', Destination + FileName); |
Busy := true; |
end; |
end; |
//Neco se stalo... |
procedure TForm1.HTTP1StateChanged(Sender: TObject; State: Smallint); |
begin |
if (State=6) then begin |
Label1.Caption:='Stahování souboru '+Download_file+' dokonèeno'; |
ListBox1.Items.Delete(0); |
Busy := false; |
Gauge1.Progress := 0; |
StatusBar1.Panels[0].Text := 'Staeno celkem '+inttostr(round(HTTP1.DocOutput.BytesTransferred/1024))+' kB, '+inttostr(8*round(HTTP1.DocOutput.BytesTransferred/(GetTickCount-Time)))+' kbps'; |
ShowMessage('Poadavek splnìn'); |
end; |
end; |
//Prace s listboxem |
procedure TForm1.ListBox1Click(Sender: TObject); |
var i: integer; |
begin |
for i := 0 to (ListBox1.Items.Count - 1) do begin |
if ListBox1.Selected[i] then |
begin |
Edit1.Text := ListBox1.Items.Strings[i]; |
ListBox1.Items.Delete(i); |
end; |
end; |
end; |
//Po stisknuti enteru se data prenesou do listboxu |
procedure TForm1.Edit1KeyDown(Sender: TObject; var Key: Word; |
Shift: TShiftState); |
begin |
if (key=13) then begin |
ListBox1.Items.Add(Edit1.Text); |
Edit1.Text:='http://'; |
end; |
end; |
//Zobrazeni formulare s cestou pro ulozeni souboru |
procedure TForm1.AutoSave1Click(Sender: TObject); |
begin |
Form1.enabled:=false; |
Form2.visible:=true; |
end; |
procedure TForm1.Timer1Timer(Sender: TObject); |
var BytesTransferred: integer; |
begin |
if busy then begin |
//Updatování pozice ukazatele |
BytesTransferred := HTTP1.DocOutput.BytesTransferred; |
Gauge1.MaxValue := HTTP1.DocOutput.BytesTotal; |
Gauge1.Progress := BytesTransferred; |
//Pøenosová rychlost B/s |
StatusBar1.Panels[2].text := inttostr(round(((BytesTransferred - BytesTransferredLast)/(Timer1.interval/1000))))+' B/s'; |
BytesTransferredLast := BytesTransferred; |
//Pocet prenesenych bytu, procento stahování a pøenosová rychlost v kbps |
if (HTTP1.DocOutput.BytesTotal <> 0)then |
StatusBar1.Panels[0].text := inttostr(round(BytesTransferred/1024))+' kB z ' |
+inttostr(round(HTTP1.DocOutput.BytesTotal/1024))+' kB = ' |
+inttostr(round(100*(BytesTransferred/1024)/(HTTP1.DocOutput.BytesTotal/1024)))+' % =' |
+inttostr(8*round(BytesTransferred/(GetTickCount-Time)))+' kbps'; |
//doba stahování |
Sekund := round((GetTickCount-Time)/1000); |
StatusBar1.Panels[1].text := inttostr(trunc(sekund/3600))+'hodin, '+inttostr(trunc(sekund/60-60*trunc(sekund/3600)))+'minut, '+inttostr(trunc(sekund)-60*(trunc(sekund/60-60*trunc(sekund/3600))))+'sekund'; |
end; |
end; |
procedure TForm1.HTTP1Error(Sender: TObject; Number: Smallint; |
var Description: WideString; Scode: Integer; const Source, |
HelpFile: WideString; HelpContext: Integer; var CancelDisplay: WordBool); |
begin |
ShowMessage('Vyskytla se chyba: '+Description); |
end; |
// ****************************************************************************** |
// Procedury pro zobrazení a skrytí ze system tray |
// ****************************************************************************** |
//Zobrazení v tray icon |
procedure TForm1.Trayicon1Click(Sender: TObject); |
begin |
//Deaktivace klavesovych zkratek |
ZkratkyZapnuty; |
// nastavíme jednotlivé poloky |
with NotifyIconData do |
begin |
cbSize := SizeOf(NotifyIconData); |
Wnd := Handle; |
uID := 0; |
uFlags := NIF_ICON + NIF_MESSAGE + NIF_TIP; |
uCallbackMessage := WM_TRAYAPPNOTIFY; |
hIcon := Application.Icon.Handle; |
szTip:='Pokusná tray aplikace'; |
end; |
// pøidáme ikonu na litu |
Shell_NotifyIcon(NIM_ADD, @NotifyIconData); |
Zobrazeni := 'TRAY_ICON'; |
end; |
//Nezobrazovat nikde |
procedure TForm1.dn1Click(Sender: TObject); |
begin |
//Oznameni o aktivaci klavesovych zkratek |
ShowMessage('Program lze aktivovat klávesovou zkratkou CTRL+F7'); |
ZkratkyZapnuty; |
// odebereme ikonu z lity |
Shell_NotifyIcon(NIM_DELETE, @NotifyIconData); |
Zobrazeni := 'NONE'; |
end; |
//Zobrazit formuláø |
procedure TForm1.Zobrazit1Click(Sender: TObject); |
begin |
Form1.visible := true; |
end; |
//Skrýt formuláø |
procedure TForm1.Skrtformul1Click(Sender: TObject); |
begin |
Form1.visible := false; |
end; |
//Události nad System Tray ikonou |
procedure TForm1.WMTrayAppNotify(var M: TMessage); |
var |
P: TPoint; |
begin |
with M do |
case lParam of |
WM_LBUTTONUP: // levé tlaèítko |
Application.MessageBox('Na ikonì bylo kliknuto!', 'Tray', 0); |
WM_RBUTTONUP: // pravé tlaèítko |
begin |
GetCursorPos(P); // získáme souøadnice kurzoru |
PopupMenu1.Popup(P.X, P.Y); // a zobrazíme na nich menu |
end; |
end; |
end; |
// ****************************************************************************** |
// Nastavení klávesových zkratek |
// ****************************************************************************** |
procedure TForm1.WMHotKey(var Message: TMessage); |
begin |
Form1.visible := true; |
end; |
procedure TForm1.ZkratkyVypnuty(); |
begin |
UnregisterHotKey(Handle,131632); |
end; |
procedure TForm1.ZkratkyZapnuty(); |
begin |
RegisterHotKey(Handle,131632,MOD_CONTROL{Control,Alt,Shift,Start},VK_F7{èíslo klávesy}); |
end; |
// ****************************************************************************** |
// Pøidání programu do START menu a na plochu |
// ****************************************************************************** |
procedure TForm1.CreateLink(WorkingDirectory,FileName,Arguments: String;TargetLinkFile: WideString; |
Description,IconPath: String;IconIdex: Integer); |
var |
MyObject : IUnknown; |
MySLink : IShellLink; |
MyPFile : IPersistFile; |
begin |
MyObject := CreateComObject(CLSID_ShellLink); |
MySLink := MyObject as IShellLink; |
MyPFile := MyObject as IPersistFile; |
with MySLink do |
begin |
SetArguments (PChar(Arguments )); |
SetPath (PChar(FileName)); |
SetWorkingDirectory(PChar(WorkingDirectory)); |
SetDescription (PChar(Description)); |
SetIconLocation (PChar(IconPath), IconIdex); |
end; |
If Not DirectoryExists(ExtractFileDir(TargetLinkFile)) then CreateDir(ExtractFileDir(TargetLinkFile)); |
MyPFile.Save(PWChar(TargetLinkFile),False); |
MySLink := Nil; |
MyPFile := Nil; |
MyObject := Nil; |
end; |
procedure TForm1.AddToStart(Sender: TObject); |
var MyReg: TRegIniFile; |
Directory: WideString; |
begin |
MyReg := TRegIniFile.Create('Software\MicroSoft\Windows\CurrentVersion\Explorer'); |
Directory := MyReg.ReadString('Shell Folders','Start Menu','')+ |
'\Programy\Download Manager\'; |
//Zástupce na program |
CreateLink(ExtractFilePath(Application.ExeName), |
Application.ExeName, |
'', |
Directory+'Download Manager v0.0.1.1.lnk', |
'Download Manager v0.0.1.1', |
Application.ExeName, |
0); |
//Zástupce na homepage GAME Developer Serveru |
CreateLink(ExtractFilePath(Application.ExeName), |
ExtractFilePath(Application.ExeName)+'Homepage.url', |
'', |
Directory+'GAME Developer Server.lnk', |
'Server o programování v DirectX a OpenGL hlavnì v Delphi a C/C++.', |
'', |
0); |
//Zástupce na clanek o Download Manageru |
CreateLink(ExtractFilePath(Application.ExeName), |
ExtractFilePath(Application.ExeName)+'Clanek.url', |
'', |
Directory+'Zdrojové kódy a popis Download Manageru.lnk', |
'Stáhnìte si zdarma zdrojové kódy a popis Download Manageru', |
'', |
0); |
//Zástupce na diskusi o Download Manageru |
CreateLink(ExtractFilePath(Application.ExeName), |
ExtractFilePath(Application.ExeName)+'Diskuse.url', |
'', |
Directory+'Diskuse o Download Manageru.lnk', |
'Zajímá vás, co si o tomto programu myslí i jiní uivatelé?', |
'', |
0); |
MyReg.Free; |
end; |
procedure TForm1.AddToDesktop(Sender: TObject); |
var MyReg: TRegIniFile; |
Directory: WideString; |
begin |
MyReg := TRegIniFile.Create('Software\MicroSoft\Windows\CurrentVersion\Explorer'); |
Directory := MyReg.ReadString('Shell Folders','Desktop',''); |
CreateLink(ExtractFilePath(Application.ExeName), |
Application.ExeName, |
'', |
Directory+'\Download Manager.lnk', |
'Download Manager', |
Application.ExeName, |
0); |
MyReg.Free; |
end; |
// ****************************************************************************** |
// Ukonèení programu |
// ****************************************************************************** |
procedure TForm1.FormDestroy(Sender: TObject); |
begin |
// odebereme ikonu z lity |
Shell_NotifyIcon(NIM_DELETE, @NotifyIconData); |
end; |
procedure TForm1.Exit1Click(Sender: TObject); |
begin |
Close; |
end; |
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction); |
begin |
Settings.WriteString('Options','Destination',Destination); |
Settings.WriteString('Options','Zobrazeni',Zobrazeni); |
Settings.Free; |
end; |
//Odkaz na moje internetove stranky |
procedure TForm1.SearchforHelpOn1Click(Sender: TObject); |
begin |
if (ShellExecute(0,'open',Pchar('http://gds.oceany.cz/index.php'),nil,nil,Sw_ShowNormal)<35) |
then ShowMessage('Dolo k chybì k pøipojení na internetový server'); |
end; |
procedure TForm1.About1Click(Sender: TObject); |
begin |
ShowMessage('Download Manager v. 0.0.1.1'+chr(13)+'Copyright: Roman Schulz'+chr(13)+'Tento program je freeware'+chr(13)+chr(13)+'Popis a zdrojáky: GAME Developer Server'+chr(13)+'http://gds.oceany.cz'); |
end; |
end. |
// ****************************************************************************** |
// This source has been created by Roman Schulz, 2002. |
// Visit my web-site at http://gds.oceany.cz for more info |
// ****************************************************************************** |
/programy/delphi/download/Download Manager 0.0.1.2/Downloader.~dfm |
---|
Cannot display: file marked as a binary type. |
svn:mime-type = application/octet-stream |
Property changes: |
Added: svn:mime-type |
+application/octet-stream |
\ No newline at end of property |
/programy/delphi/download/Download Manager 0.0.1.2/Downloader.~pas |
---|
0,0 → 1,494 |
// ****************************************************************************** |
// This source has been created by Roman Schulz, 2002. |
// Visit my web-site at http://gds.oceany.cz for more info |
// ****************************************************************************** |
unit Downloader; |
interface |
uses |
Windows, ShellAPI, Messages, SysUtils, Graphics, Forms, Dialogs, Classes, |
StdCtrls, isp3, Menus, INIFiles, OleCtrls, Controls, FileCtrl, Registry, |
ComObj, ActiveX, ShlObj, ComCtrls, ExtCtrls, Gauges; |
const |
WM_TRAYAPPNOTIFY = WM_USER; // vlastní identifikátor zprávy |
type |
TForm1 = class(TForm) |
Edit1: TEdit; |
ListBox1: TListBox; |
Button1: TButton; |
Button2: TButton; |
HTTP1: THTTP; |
Label1: TLabel; |
MainMenu1: TMainMenu; |
File1: TMenuItem; |
Exit1: TMenuItem; |
Help1: TMenuItem; |
About1: TMenuItem; |
SearchforHelpOn1: TMenuItem; |
Reset1: TMenuItem; |
AutoSave1: TMenuItem; |
Zobrazen1: TMenuItem; |
dn1: TMenuItem; |
PopupMenu1: TPopupMenu; |
Konec1: TMenuItem; |
Zobrazit1: TMenuItem; |
Trayicon1: TMenuItem; |
Skrtformul1: TMenuItem; |
Skrtformul2: TMenuItem; |
Download1: TMenuItem; |
Hledatnainternetu1: TMenuItem; |
Button3: TButton; |
PidatdoSTARTmenu1: TMenuItem; |
Pidatnaplochu1: TMenuItem; |
StatusBar1: TStatusBar; |
Timer1: TTimer; |
Gauge1: TGauge; |
Vceoaplikaci1: TMenuItem; |
procedure Edit1KeyDown(Sender: TObject; var Key: Word; |
Shift: TShiftState); |
procedure Button2Click(Sender: TObject); |
procedure HTTP1StateChanged(Sender: TObject; State: Smallint); |
procedure Button1Click(Sender: TObject); |
procedure ListBox1Click(Sender: TObject); |
procedure AutoSave1Click(Sender: TObject); |
procedure Exit1Click(Sender: TObject); |
procedure FormClose(Sender: TObject; var Action: TCloseAction); |
procedure SearchforHelpOn1Click(Sender: TObject); |
procedure dn1Click(Sender: TObject); |
procedure ZkratkyVypnuty; |
procedure ZkratkyZapnuty; |
procedure FormDestroy(Sender: TObject); |
procedure Trayicon1Click(Sender: TObject); |
procedure Zobrazit1Click(Sender: TObject); |
procedure Skrtformul1Click(Sender: TObject); |
procedure About1Click(Sender: TObject); |
procedure CreateLink(WorkingDirectory,FileName,Arguments: String;TargetLinkFile: WideString; |
Description,IconPath: String;IconIdex: Integer); |
procedure AddToStart(Sender: TObject); |
procedure AddToDesktop(Sender: TObject); |
procedure Timer1Timer(Sender: TObject); |
procedure HTTP1Error(Sender: TObject; Number: Smallint; |
var Description: WideString; Scode: Integer; const Source, |
HelpFile: WideString; HelpContext: Integer; |
var CancelDisplay: WordBool); |
private |
Download_file, Zobrazeni: String; |
Busy: boolean; |
Settings: TINIFile; |
NotifyIconData: TNotifyIconData; // data pro ikonu |
Time: Dword; |
Sekund, BytesTransferredLast: Integer; |
procedure WMTrayAppNotify(var M: TMessage); message WM_TRAYAPPNOTIFY; |
public |
Destination: String; |
protected |
procedure WMHotKey(var Message: TMessage); message WM_HOTKEY; |
end; |
var |
Form1: TForm1; |
implementation |
uses SaveDialog; |
{$R *.DFM} |
// ****************************************************************************** |
// Rutiny download manageru |
// ****************************************************************************** |
//Reset |
procedure TForm1.Button1Click(Sender: TObject); |
var i, dummy: integer; |
//param: DWord; |
begin |
//Monost vypnutí vekerých klávesových zkratek ve Win9x |
//Param := 0; |
//SystemParametersInfo(SPI_SETFASTTASKSWITCH, UINT(not false), @Param, 0); |
// ALT+TAB, CTRL+ESC |
//SystemParametersInfo(SPI_SCREENSAVERRUNNING, UINT(not false), @Param, 0); |
// CTRL+ALT+DEL |
//Vlozi zacatek internetove adresy |
Edit1.text := 'http://'; |
//Stornujeme stahování |
if HTTP1.Busy then HTTP1.Cancel; |
Busy := false; |
Label1.caption := 'Pøipraven na stahování'; |
//Skrytí task baru |
ShowWindow(Application.Handle, SW_HIDE); //schová aplikaci z taskbaru |
//Nacteni hodnot z konfiguracniho souboru |
Settings:=TIniFile.Create((ExtractFilePath(Application.ExeName))+'settings.cfg'); |
//Nacteni cile ukládání |
Destination := Settings.ReadString('Options','Destination',ExtractFilePath(Application.ExeName)); |
//Kde se ma zobrazit ikonka |
Zobrazeni := Settings.ReadString('Options','Zobrazeni','TRAY_ICON'); |
if Zobrazeni = 'TRAY_ICON' then Trayicon1Click(Sender) |
else if Zobrazeni = 'NONE' then dn1Click(Sender) |
else Trayicon1Click(Sender); |
//Vymazani celeho mema |
for i:=1 to ListBox1.Items.Count do ListBox1.Items.Delete(0); |
end; |
//Stahuj |
procedure TForm1.Button2Click(Sender: TObject); |
var i:integer; |
FileName:string; |
begin |
if (ListBox1.Items.Count <> 0) then |
if (Busy = false) then begin |
Download_file := ListBox1.Items.Strings[0]; |
//Ziskani jmena souboru z internetove adresy |
for i:=0 to Length(Download_file) do |
if (Download_file[i]<>'/') then FileName := FileName + Download_file[i] |
else FileName:=''; |
//Stavový label |
Label1.caption:='Stahování souboru: '+Download_file; |
Time := GetTickCount; |
HTTP1.GetDoc(Download_file, '', Destination + FileName); |
Busy := true; |
end; |
end; |
//Neco se stalo... |
procedure TForm1.HTTP1StateChanged(Sender: TObject; State: Smallint); |
begin |
if (State=6) then begin |
Label1.Caption:='Stahování souboru '+Download_file+' dokonèeno'; |
ListBox1.Items.Delete(0); |
Busy := false; |
Gauge1.Progress := 0; |
StatusBar1.Panels[0].Text := 'Staeno celkem '+inttostr(round(HTTP1.DocOutput.BytesTransferred/1024))+' kB, '+inttostr(8*round(HTTP1.DocOutput.BytesTransferred/(GetTickCount-Time)))+' kbps'; |
ShowMessage('Poadavek splnìn'); |
end; |
end; |
//Prace s listboxem |
procedure TForm1.ListBox1Click(Sender: TObject); |
var i: integer; |
begin |
for i := 0 to (ListBox1.Items.Count - 1) do begin |
if ListBox1.Selected[i] then |
begin |
Edit1.Text := ListBox1.Items.Strings[i]; |
ListBox1.Items.Delete(i); |
end; |
end; |
end; |
//Po stisknuti enteru se data prenesou do listboxu |
procedure TForm1.Edit1KeyDown(Sender: TObject; var Key: Word; |
Shift: TShiftState); |
begin |
if (key=13) then begin |
ListBox1.Items.Add(Edit1.Text); |
Edit1.Text:='http://'; |
end; |
end; |
//Zobrazeni formulare s cestou pro ulozeni souboru |
procedure TForm1.AutoSave1Click(Sender: TObject); |
begin |
Form1.enabled:=false; |
Form2.visible:=true; |
end; |
procedure TForm1.Timer1Timer(Sender: TObject); |
var BytesTransferred: integer; |
begin |
if busy then begin |
//Updatování pozice ukazatele |
BytesTransferred := HTTP1.DocOutput.BytesTransferred; |
Gauge1.MaxValue := HTTP1.DocOutput.BytesTotal; |
Gauge1.Progress := BytesTransferred; |
//Pøenosová rychlost B/s |
StatusBar1.Panels[2].text := inttostr(round(((BytesTransferred - BytesTransferredLast)/(Timer1.interval/1000))))+' B/s'; |
BytesTransferredLast := BytesTransferred; |
//Pocet prenesenych bytu, procento stahování a pøenosová rychlost v kbps |
if (HTTP1.DocOutput.BytesTotal <> 0)then |
StatusBar1.Panels[0].text := inttostr(round(BytesTransferred/1024))+' kB z ' |
+inttostr(round(HTTP1.DocOutput.BytesTotal/1024))+' kB = ' |
+inttostr(round(100*(BytesTransferred/1024)/(HTTP1.DocOutput.BytesTotal/1024)))+' % =' |
+inttostr(8*round(BytesTransferred/(GetTickCount-Time)))+' kbps'; |
//doba stahování |
Sekund := round((GetTickCount-Time)/1000); |
StatusBar1.Panels[1].text := inttostr(trunc(sekund/3600))+'hodin, '+inttostr(trunc(sekund/60-60*trunc(sekund/3600)))+'minut, '+inttostr(trunc(sekund)-60*(trunc(sekund/60-60*trunc(sekund/3600))))+'sekund'; |
end; |
end; |
procedure TForm1.HTTP1Error(Sender: TObject; Number: Smallint; |
var Description: WideString; Scode: Integer; const Source, |
HelpFile: WideString; HelpContext: Integer; var CancelDisplay: WordBool); |
begin |
ShowMessage('Vyskytla se chyba: '+Description); |
end; |
// ****************************************************************************** |
// Procedury pro zobrazení a skrytí ze system tray |
// ****************************************************************************** |
//Zobrazení v tray icon |
procedure TForm1.Trayicon1Click(Sender: TObject); |
begin |
//Deaktivace klavesovych zkratek |
ZkratkyZapnuty; |
// nastavíme jednotlivé poloky |
with NotifyIconData do |
begin |
cbSize := SizeOf(NotifyIconData); |
Wnd := Handle; |
uID := 0; |
uFlags := NIF_ICON + NIF_MESSAGE + NIF_TIP; |
uCallbackMessage := WM_TRAYAPPNOTIFY; |
hIcon := Application.Icon.Handle; |
szTip:='Pokusná tray aplikace'; |
end; |
// pøidáme ikonu na litu |
Shell_NotifyIcon(NIM_ADD, @NotifyIconData); |
Zobrazeni := 'TRAY_ICON'; |
end; |
//Nezobrazovat nikde |
procedure TForm1.dn1Click(Sender: TObject); |
begin |
//Oznameni o aktivaci klavesovych zkratek |
ShowMessage('Program lze aktivovat klávesovou zkratkou CTRL+F7'); |
ZkratkyZapnuty; |
// odebereme ikonu z lity |
Shell_NotifyIcon(NIM_DELETE, @NotifyIconData); |
Zobrazeni := 'NONE'; |
end; |
//Zobrazit formuláø |
procedure TForm1.Zobrazit1Click(Sender: TObject); |
begin |
Form1.visible := true; |
end; |
//Skrýt formuláø |
procedure TForm1.Skrtformul1Click(Sender: TObject); |
begin |
Form1.visible := false; |
end; |
//Události nad System Tray ikonou |
procedure TForm1.WMTrayAppNotify(var M: TMessage); |
var |
P: TPoint; |
begin |
with M do |
case lParam of |
WM_LBUTTONUP: // levé tlaèítko |
Application.MessageBox('Na ikonì bylo kliknuto!', 'Tray', 0); |
WM_RBUTTONUP: // pravé tlaèítko |
begin |
GetCursorPos(P); // získáme souøadnice kurzoru |
PopupMenu1.Popup(P.X, P.Y); // a zobrazíme na nich menu |
end; |
end; |
end; |
// ****************************************************************************** |
// Nastavení klávesových zkratek |
// ****************************************************************************** |
procedure TForm1.WMHotKey(var Message: TMessage); |
begin |
Form1.visible := true; |
end; |
procedure TForm1.ZkratkyVypnuty(); |
begin |
UnregisterHotKey(Handle,131632); |
end; |
procedure TForm1.ZkratkyZapnuty(); |
begin |
RegisterHotKey(Handle,131632,MOD_CONTROL{Control,Alt,Shift,Start},VK_F7{èíslo klávesy}); |
end; |
// ****************************************************************************** |
// Pøidání programu do START menu a na plochu |
// ****************************************************************************** |
procedure TForm1.CreateLink(WorkingDirectory,FileName,Arguments: String;TargetLinkFile: WideString; |
Description,IconPath: String;IconIdex: Integer); |
var |
MyObject : IUnknown; |
MySLink : IShellLink; |
MyPFile : IPersistFile; |
begin |
MyObject := CreateComObject(CLSID_ShellLink); |
MySLink := MyObject as IShellLink; |
MyPFile := MyObject as IPersistFile; |
with MySLink do |
begin |
SetArguments (PChar(Arguments )); |
SetPath (PChar(FileName)); |
SetWorkingDirectory(PChar(WorkingDirectory)); |
SetDescription (PChar(Description)); |
SetIconLocation (PChar(IconPath), IconIdex); |
end; |
If Not DirectoryExists(ExtractFileDir(TargetLinkFile)) then CreateDir(ExtractFileDir(TargetLinkFile)); |
MyPFile.Save(PWChar(TargetLinkFile),False); |
MySLink := Nil; |
MyPFile := Nil; |
MyObject := Nil; |
end; |
procedure TForm1.AddToStart(Sender: TObject); |
var MyReg: TRegIniFile; |
Directory: WideString; |
begin |
MyReg := TRegIniFile.Create('Software\MicroSoft\Windows\CurrentVersion\Explorer'); |
Directory := MyReg.ReadString('Shell Folders','Start Menu','')+ |
'\Programy\Download Manager\'; |
//Zástupce na program |
CreateLink(ExtractFilePath(Application.ExeName), |
Application.ExeName, |
'', |
Directory+'Download Manager v0.0.1.1.lnk', |
'Download Manager v0.0.1.1', |
Application.ExeName, |
0); |
//Zástupce na homepage GAME Developer Serveru |
CreateLink(ExtractFilePath(Application.ExeName), |
ExtractFilePath(Application.ExeName)+'Homepage.url', |
'', |
Directory+'GAME Developer Server.lnk', |
'Server o programování v DirectX a OpenGL hlavnì v Delphi a C/C++.', |
'', |
0); |
//Zástupce na clanek o Download Manageru |
CreateLink(ExtractFilePath(Application.ExeName), |
ExtractFilePath(Application.ExeName)+'Clanek.url', |
'', |
Directory+'Zdrojové kódy a popis Download Manageru.lnk', |
'Stáhnìte si zdarma zdrojové kódy a popis Download Manageru', |
'', |
0); |
//Zástupce na diskusi o Download Manageru |
CreateLink(ExtractFilePath(Application.ExeName), |
ExtractFilePath(Application.ExeName)+'Diskuse.url', |
'', |
Directory+'Diskuse o Download Manageru.lnk', |
'Zajímá vás, co si o tomto programu myslí i jiní uivatelé?', |
'', |
0); |
MyReg.Free; |
end; |
procedure TForm1.AddToDesktop(Sender: TObject); |
var MyReg: TRegIniFile; |
Directory: WideString; |
begin |
MyReg := TRegIniFile.Create('Software\MicroSoft\Windows\CurrentVersion\Explorer'); |
Directory := MyReg.ReadString('Shell Folders','Desktop',''); |
CreateLink(ExtractFilePath(Application.ExeName), |
Application.ExeName, |
'', |
Directory+'\Download Manager.lnk', |
'Download Manager', |
Application.ExeName, |
0); |
MyReg.Free; |
end; |
// ****************************************************************************** |
// Ukonèení programu |
// ****************************************************************************** |
procedure TForm1.FormDestroy(Sender: TObject); |
begin |
// odebereme ikonu z lity |
Shell_NotifyIcon(NIM_DELETE, @NotifyIconData); |
end; |
procedure TForm1.Exit1Click(Sender: TObject); |
begin |
Close; |
end; |
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction); |
begin |
Settings.WriteString('Options','Destination',Destination); |
Settings.WriteString('Options','Zobrazeni',Zobrazeni); |
Settings.Free; |
end; |
//Odkaz na moje internetove stranky |
procedure TForm1.SearchforHelpOn1Click(Sender: TObject); |
begin |
if (ShellExecute(0,'open',Pchar('http://gds.oceany.cz/index.php'),nil,nil,Sw_ShowNormal)<35) |
then ShowMessage('Dolo k chybì k pøipojení na internetový server'); |
end; |
procedure TForm1.About1Click(Sender: TObject); |
begin |
ShowMessage('Download Manager v. 0.0.1.1'+chr(13)+'Copyright: Roman Schulz'+chr(13)+'Tento program je freeware'+chr(13)+chr(13)+'Popis a zdrojáky: GAME Developer Server'+chr(13)+'http://gds.oceany.cz'); |
end; |
end. |
// ****************************************************************************** |
// This source has been created by Roman Schulz, 2002. |
// Visit my web-site at http://gds.oceany.cz for more info |
// ****************************************************************************** |
/programy/delphi/download/Download Manager 0.0.1.2/Homepage.url |
---|
0,0 → 1,2 |
[InternetShortcut] |
URL=http://gds.oceany.cz/index.php |
/programy/delphi/download/Download Manager 0.0.1.2/SETTINGS.CFG |
---|
0,0 → 1,3 |
[Options] |
Destination=D:\ |
Zobrazeni=NONE |
/programy/delphi/download/Download Manager 0.0.1.2/SaveDialog.dcu |
---|
Cannot display: file marked as a binary type. |
svn:mime-type = application/octet-stream |
Property changes: |
Added: svn:mime-type |
+application/octet-stream |
\ No newline at end of property |
/programy/delphi/download/Download Manager 0.0.1.2/SaveDialog.dfm |
---|
Cannot display: file marked as a binary type. |
svn:mime-type = application/octet-stream |
Property changes: |
Added: svn:mime-type |
+application/octet-stream |
\ No newline at end of property |
/programy/delphi/download/Download Manager 0.0.1.2/SaveDialog.pas |
---|
0,0 → 1,77 |
// ****************************************************************************** |
// This source has been created by Roman Schulz, 2002. |
// Visit my web-site at http://gds.oceany.cz for more info |
// ****************************************************************************** |
unit SaveDialog; |
interface |
uses |
SysUtils, Dialogs, Forms, Controls, Classes, StdCtrls; |
type |
TForm2 = class(TForm) |
Edit1: TEdit; |
Button1: TButton; |
Button2: TButton; |
Label1: TLabel; |
Button3: TButton; |
procedure Button1Click(Sender: TObject); |
procedure FormCreate(Sender: TObject); |
procedure Button2Click(Sender: TObject); |
procedure Button3Click(Sender: TObject); |
private |
Destination: string; |
end; |
var |
Form2: TForm2; |
implementation |
uses Downloader; |
{$R *.DFM} |
//setup |
procedure TForm2.FormCreate(Sender: TObject); |
begin |
Destination := Form1.destination; |
Edit1.text := Form1.Destination; |
end; |
//OK |
procedure TForm2.Button1Click(Sender: TObject); |
begin |
Form1.Destination := Edit1.Text; |
Form1.enabled := true; |
Form2.visible := false; |
end; |
//Reset |
procedure TForm2.Button2Click(Sender: TObject); |
begin |
Form1.Destination := Destination; |
Form1.enabled := true; |
Form2.visible := false; |
end; |
//Default |
procedure TForm2.Button3Click(Sender: TObject); |
begin |
Form1.Destination := ExtractFilePath(Application.ExeName); |
Edit1.text := ExtractFilePath(Application.ExeName); |
end; |
end. |
// ****************************************************************************** |
// This source has been created by Roman Schulz, 2002. |
// Visit my web-site at http://gds.oceany.cz for more info |
// ****************************************************************************** |
/programy/delphi/download/Download Manager 0.0.1.2/vssver.scc |
---|
Cannot display: file marked as a binary type. |
svn:mime-type = application/octet-stream |
Property changes: |
Added: svn:mime-type |
+application/octet-stream |
\ No newline at end of property |