Mega Code Archive
Internetteki bir url sayfasını diske kaydetmek
<![CDATA[
Code By GeNiUS !
genius_user@yahoo.com
{Delphi Code}
Function InternetCopyURLToFile(
SourceURL : String;
DestFile : String;
ShowMessages : Boolean;
StatusPanel : TPanel
): Boolean;
const MAX_PATH = 255;
var
hStdOut : THandle;
OutDir : String;
OutFile : String;
{ Msg : String;}{zzz}
{Start Embedded Functions in CopyURL}
Function InternetLoadRate(
StartTime : TDateTime;
iBytes : integer
): integer;
Var
iStartSecond : integer;
iSeconds : integer;
Hour : word;
Min : word;
Sec : word;
MSec : word;
Begin
DecodeTime( StartTime, Hour, Min, Sec, MSec );
iStartSecond := Sec + Min * 60 + Hour * 360;
DecodeTime( Now, Hour, Min, Sec, MSec );
iSeconds := ( Sec + Min * 60 + Hour * 360 ) - iStartSecond;
If ( Trunc( Now - StartTime ) > 0 ) Then
Begin
iSeconds := iSeconds + Trunc( Now - StartTime ) * 24 * 60 * 60;
End;
If ( iSeconds > 0 ) Then
Begin
Result := iBytes div iSeconds;
End
Else
Begin
Result := 0;
End;
end;
Function InternetGetFile(
Source_Handle : HINTERNET;
DestFile_Handle : THandle;
ShowMessages : Boolean;
StatusPanel : TPanel
): Boolean;
const FILE_SMALL_BUFFER = 4096;
const RETRY_READ = 10;
Var
iRetry : integer;
bOk : bool;
StartTime : TDateTime;
EndTime : TDateTime;
iWriteFileTotal : integer;
iWriteFileCount : integer;
iReadFileCount : integer;
SmallBuffer : array [ 1..FILE_SMALL_BUFFER ] of char;
Msg : String;
Begin
Result := False;
Try
iWriteFileTotal := 0;
StartTime := Now;
Repeat
Begin
If (StatusPanel <> nil) Then
Begin
StatusPanel.Caption :=
IntToStr(iWriteFileTotal)+
' bytes transferred ... (' +
IntToStr(InternetLoadRate( StartTime, iWriteFileTotal ))+
' bytes/sec)';
StatusPanel.Refresh;
End;
iRetry := 0;
Repeat
Begin
iReadFileCount := 0;
bOk :=
InternetReadFile(
Source_Handle,
@SmallBuffer,
FILE_SMALL_BUFFER,
iReadFileCount);
Inc( iRetry );
End;
Until ((iReadFileCount <> 0) or (bOk) or (iRetry = RETRY_READ));
If (iReadFileCount > 0) Then
Begin
iWriteFileCount := 0;
bOk :=
WriteFile(
DestFile_Handle,
SmallBuffer,
iReadFileCount,
iWriteFileCount,
nil);
bOk := (bOk) and (iReadFileCount = iWriteFileCount);
If (bOk) Then
Begin
iWriteFileTotal := iWriteFileTotal + iWriteFileCount;
End
Else
Begin
iReadFileCount := 0;
Msg := 'Error writing to the output file.';
If (StatusPanel <> nil) Then
Begin
StatusPanel.Caption := Msg;
StatusPanel.Refresh;
End;
If ShowMessages Then
Begin
ShowMessage(Msg);
End;
Exit;
End;
End
Else
Begin
If (not bOk) Then
Begin
Msg := 'Error reading the data.';
If (StatusPanel <> nil) Then
Begin
StatusPanel.Caption := Msg;
StatusPanel.Refresh;
End;
If ShowMessages Then ShowMessage(Msg);
Exit;
End;
End;
End;
Until (iReadFileCount = 0);
EndTime := now();
If (StatusPanel <> nil) Then
Begin
StatusPanel.Caption :=
'('+
FormatFloat(
'###,###,##0',
TimeDeltaInSeconds(
StartTime,
EndTime))+
' seconds)';
StatusPanel.Refresh;
End;
Result := True;
Except
Result := False;
End;
end;
Function InternetFetchFile(
hSession : HINTERNET;
SourceURL : string;
DestFile : string;
hStdOut : THandle;
ShowMessages : Boolean;
RevealDest : Boolean;
StatusPanel : TPanel
): Boolean;
Var
Source_Handle : HINTERNET;
DestFile_Handle : THandle;
Msg : String;
Begin
Result := False;
Try
Msg := 'Opening "'+SourceURL+'"';
If (StatusPanel <> nil) Then
Begin
StatusPanel.Caption := Msg;
StatusPanel.Refresh;
End;
Source_Handle :=
InternetOpenUrl(
hSession,
PChar(SourceURL),
nil,
-1,
INTERNET_FLAG_DONT_CACHE or
INTERNET_FLAG_RAW_DATA,
0);
If (Source_Handle <> nil) Then
Begin
If (DestFile = '') Then
Begin
DestFile_Handle := hStdOut;
If RevealDest Then
Begin
Msg := 'Output directed to default';
End
Else
Begin
Msg := 'Output initiated';
End;
If (StatusPanel <> nil) Then
Begin
StatusPanel.Caption := Msg;
StatusPanel.Refresh;
End;
End
Else
Begin
If RevealDest Then
Begin
Msg := 'Creating "'+DestFile+'"';
End
Else
Begin
Msg := 'Output initiated';
End;
If (StatusPanel <> nil) Then
Begin
StatusPanel.Caption := Msg;
StatusPanel.Refresh;
End;
DestFile_Handle :=
CreateFile(
PChar(DestFile),
GENERIC_WRITE,
FILE_SHARE_READ,
nil,
CREATE_NEW,
FILE_FLAG_WRITE_THROUGH or
FILE_FLAG_SEQUENTIAL_SCAN,
0 );
End;
If (DestFile_Handle <> INVALID_HANDLE_VALUE ) Then
Begin
Msg := 'Starting Download';
If (StatusPanel <> nil) Then
Begin
StatusPanel.Caption := Msg;
StatusPanel.Refresh;
End;
InternetGetFile(
Source_Handle,
DestFile_Handle,
ShowMessages,
StatusPanel);
If (DestFile_Handle <> hStdOut ) Then
Begin
CloseHandle(DestFile_Handle);
End;
End
Else
Begin
Msg := 'Output Failed!!! Closing "'+SourceURL+'"';
If (StatusPanel <> nil) Then
Begin
StatusPanel.Caption := Msg;
StatusPanel.Refresh;
End;
If ShowMessages Then
Begin
ShowMessage(Msg);
End;
InternetCloseHandle(Source_Handle);
Exit;
End;
End
Else
Begin
Msg := 'URL could not be opened';
If (StatusPanel <> nil) Then
Begin
StatusPanel.Caption := Msg;
StatusPanel.Refresh;
End;
If ShowMessages Then
Begin
ShowMessage(Msg);
End;
Exit;
End;
Result := True;
Except
Result := False;
End;
End;
Function InternetCreateSession(
SourceUrl : string;
DestFile : string;
sCaller : string;
hStdOut : THandle;
ShowMessages : Boolean;
StatusPanel : TPanel
): Boolean;
Var
hSession : HINTERNET;
Msg : String;
Begin
Result := False;
Try
Msg := 'Opening Internet Session "'+ sCaller+'"';
If (StatusPanel <> nil) Then
Begin
StatusPanel.Caption := Msg;
StatusPanel.Refresh;
End;
hSession :=
InternetOpen(
PChar(sCaller),
LOCAL_INTERNET_ACCESS,
nil,
PChar(INTERNET_INVALID_PORT_NUMBER),
INTERNET_FLAG_DONT_CACHE );
If (hSession <> nil) Then
Begin
Msg := 'Done "'+ sCaller+'" ';
If InternetFetchFile(
hSession,
SourceURL,
DestFile,
hStdOut,
ShowMessages,
False,
StatusPanel) Then
Begin
If (StatusPanel <> nil) Then
Begin
StatusPanel.Caption := Msg + StatusPanel.Caption;
StatusPanel.Refresh;
End;
InternetCloseHandle( hSession );
End
Else
Begin
If (StatusPanel <> nil) Then
Begin
StatusPanel.Caption := Msg + StatusPanel.Caption;
StatusPanel.Refresh;
End;
InternetCloseHandle( hSession );
Exit;
End;
End
Else
Begin
Msg := 'Internet session not opened. Process Aborted!';
If (StatusPanel <> nil) Then
Begin
StatusPanel.Caption := Msg;
StatusPanel.Refresh;
End;
If ShowMessages Then
Begin
ShowMessage(Msg);
End;
Exit;
End;
Result := True;
Except
Result := False;
End;
End;
// End Embedded Functions in CopyURL
Begin
Result := False;
Try
{Check the input parameters}
If SourceUrl = '' Then
Begin
If ShowMessages Then
Begin
ShowMessage('No Source URL was provided. Process Aborted!');
End;
Exit;
End;
If DestFile = '' Then
Begin
If ShowMessages Then
Begin
ShowMessage('No Destination File was provided. Process Aborted!');
End;
Exit;
End;
If (Length(SourceUrl) > INTERNET_MAX_URL_LENGTH ) Then
Begin
If ShowMessages Then
Begin
ShowMessage(
'URL is longer than '+
IntToStr(INTERNET_MAX_URL_LENGTH)+
'. Process Aborted!');
End;
Exit;
End;
If FileExists(OutFile) Then SysUtils.DeleteFile(OutFile);
OutDir := FilePath(DestFile);
OutFile:= ExtractFileName(DestFile);
If Not DirectoryExists(OutDir) Then
Begin
If ShowMessages Then
Begin
ShowMessage('Output Path = '+OutDir);
ShowMessage('The Output directory does not exist. Process Aborted!');
End;
Exit;
End;
If Length(DestFile) > 255 Then
Begin
If ShowMessages Then
Begin
ShowMessage('The Output File and Path are too long. Process Aborted!');
End;
Exit;
End;
hStdOut := GetStdHandle( STD_OUTPUT_HANDLE );
Result := InternetCreateSession(
SourceURL,
DestFile,
SourceURL,
hStdOut,
ShowMessages,
StatusPanel);
If Not Result Then
Begin
If (StatusPanel <> nil) Then
Begin
StatusPanel.Caption := '';
StatusPanel.Refresh;
End;
End;
Except
Result := False;
End;
End;
]]>