چجوری میشه برنامه ای نوشت که فایلی رو از اینترنت دانلود کنه ولی پنجره داناود نیاد یا مخفی بشه.

[javid_debugger]

چجوری میشه برنامه ای نوشت که فایلی رو از اینترنت دانلود کنه ولی پنجره داناود نیاد یا مخفی بشه.

[noorsoft]

باید خودتون با استفاده از کنترل اینترنت وی بی برنامه اون را بنویسی تو تاپیک ابزارهای برنامه نویسی وی بی نمونه هاش هست

[ASKaffash]

سلام
دوست عزیز یک مثال قبلا نوشتم که از طریق کنترل Inet و WinSock با VB با پروتکل FTP تبادل فایل میکند چون مخصوص یک سازمان است تنها یک بخش مهم که برایتان مفید است وطریقه دریافت وارسال را استفاده کرده برایتان قرار میدهم امیدوارم از خواندن مثال موضوع دستگیر شود :

Private ProcTimer As Single
Private LastCommand As String
Private RunFTP As Integer
Private Const SohWinSockPort = 1001 'Pc/Client
Private Const SohReaderPort = 7070 'Identec/Reader
Private OkC As Variant ' Connection/Color
Private NoC As Variant ' No Connection/Color
Private DaC As Variant ' Data Transfer/Color
Private PacketString As String
Private Sub BInet_StateChanged(ByVal State As Integer)
Select Case True
Case State = 11 ' Error
RunFTP = 0
Case RunFTP = 0 + 10 And (State = 8 Or State = 12) ' Get Ack
If GetAckFile() Then
RunFTP = 1
Else
RunFTP = 0 + 10
End If
Case RunFTP = 2 And (State = 8 Or State = 12) ' Put Packet
RunFTP = 3
Case RunFTP = 4 And (State = 8 Or State = 12) ' Put Ack
'Set Ok=2-->Ok=1
Call RunSP("FreeOK")
RunFTP = 0
End Select
End Sub
Private Sub Form_Load()
If App.PrevInstance Then End
RunFTP = 0
Call GetFormShape(Me)
Me.BLabel.Caption = Me.SWinsock(1).LocalIP
OkC = RGB(100, 255, 100)
NoC = RGB(255, 100, 100)
DaC = RGB(255, 255, 100)
With NID
.cbSize = Len(NID)
.hWnd = Me.hWnd
.uId = vbNull
.uFlags = &H1 Or &H4 Or &H2
.uCallBackMessage = &H200
.hIcon = Me.Icon
.szTip = "Data Capture With TCP/IP " & vbLf & "By S.S.Kaffash" & vbNullChar
End With
Shell_NotifyIcon &H0, NID
Me.Adodc1.Refresh
CntIP = 0
With Me.Adodc1.Recordset
Do While Not .EOF
If !IPType <> 0 Then
CntIP = CntIP + 1
Me.SLabel(CntIP).Caption = !IPValue
Me.SLabel(CntIP).Tag = Trim(Str(!IPCode))
Me.SShape(CntIP).Tag = Trim(Str(!IPType))
End If
.MoveNext
Loop
End With
Me.Adodc2.Refresh
Me.Adodc3.RecordSource = "GetSetting 1"
Me.Adodc3.Refresh
With PacketSet
.RunType = Val(Me.Adodc3.Recordset!VSet1)
.PingTime = Val(Me.Adodc3.Recordset!VSet2)
.InetTime = Val(Me.Adodc3.Recordset!VSet3)
End With
Me.Adodc3.RecordSource = "GetSetting 2"
Me.Adodc3.Refresh
With PacketSet
.SendTime = Val(Me.Adodc3.Recordset!VSet1)
.URL = Trim(Me.Adodc3.Recordset!VSet2)
.Path = App.Path + "\"
.FileName = Trim(Me.Adodc3.Recordset!VSet3)
End With
Me.BInet.URL = PacketSet.URL
ProcTimer = Timer
End Sub
Private Sub Form_Unload(Cancel As Integer)
If Not (RunFTP = 0 Or RunFTP = 0 + 10) Then
Cancel = 1
Exit Sub
End If
Call SaveFormShape(Me)
Shell_NotifyIcon &H2, NID
End Sub
Private Sub SLabel_DblClick(Index As Integer)
If Len(Trim(Me.SLabel(Index).Caption)) <> 0 Then
Me.SLabel(Index).BackColor = RGB(100, 100, 255)
If Me.SWinsock(Index).State = 7 Then
Me.SLabel(Index).BackColor = RGB(255, 255, 100)
Me.SWinsock(Index).SendData SetDateTime()
End If
End If
End Sub
Private Sub SWinsock_DataArrival(Index As Integer, ByVal bytesTotal As Long)
Err.Number = 0
On Error GoTo End1
Dim StrData As String
Me.SWinsock(Index).GetData StrData
Me.SShape(Index).BackColor = DaC
With Me.Adodc2.Recordset
.AddNew
!Cmd = "D"
!IPCode = Val(Me.SLabel(Index).Tag)
!PktDate = Format(Date, "YY/MM/DD")
!PktTime = Format(Time, "HH:MM:SS")
!PktStr = StrData
!OK = 0
.Update
If Me.SShape(Index).Tag = "2" Then
Acknowledge = "#8068" + vbCr
Me.SWinsock(Index).SendData Acknowledge
End If
Me.SWinsock(Index).Tag = CStr(Timer)
End With
End1:
If Err.Number <> 0 Then End
End Sub
Private Sub NewConnect(ByVal WinSockID As Variant)
With Me.SWinsock(WinSockID)
If Len(Trim(Me.SLabel(WinSockID).Caption)) <> 0 Then
.RemoteHost = Trim(Me.SLabel(WinSockID).Caption)
If Me.SShape(WinSockID).Tag = "1" Then ' 1=Pc/Server 2=Identec/Reader
.RemotePort = SohWinSockPort
Me.SLabel(WinSockID).ToolTipText = "Pc/Server"
Else
.RemotePort = SohReaderPort
Me.SLabel(WinSockID).ToolTipText = "Identec/Reader"
End If
.Connect
End If
End With
End Sub
Private Sub Timer1_Timer()
Err.Number = 0
On Error GoTo End2
' For Move Icon
Me.Caption = Format(Time, "HH:MM:SS")
Me.LabelTimer.Caption = Val2Time(Int(Timer - ProcTimer + 0.5))
Static CntImage As Byte
CntImage = IIf(CntImage = 10, 1, CntImage + 1)
NID.hIcon = Me.Image1(CntImage).Picture
Me.Image2.Picture = Me.Image1(CntImage).Picture
Shell_NotifyIcon &H1, NID
' For Connect To Reader/Pc Listen/...
Static CntTimer1 As Long
CntTimer1 = CntTimer1 + 1
If CntTimer1 = 2 Then
CntTimer1 = 0
For i = 1 To Me.SWinsock.Count
If Me.SWinsock(i).State <> 7 Or Abs(Timer - Val(Me.SWinsock(i).Tag)) > 5 * 60 Then
Me.SWinsock(i).Close
Call NewConnect(i)
End If
If Me.SWinsock(i).State <> 0 Then
Me.NLabel(i).Caption = Me.SWinsock(i).State
Me.SShape(i).BackColor = IIf(Me.SWinsock(i).State = 7, OkC, NoC)
End If
Next
End If
' For Ping
Static CntTimer2 As Long
CntTimer2 = CntTimer2 + 1
If CntTimer2 = PacketSet.PingTime * 60 Then
CntTimer2 = 0
Dim VarPinging As clsICMPPing
Set VarPinging = New clsICMPPing
CntIP = 0
SumPinging = ""
Me.Adodc1.Recordset.MoveFirst
With Me.Adodc1.Recordset
Do While Not .EOF
CntIP = CntIP + 1
VPingState = VarPinging.Ping(!IPValue)
SumPinging = SumPinging + "[" + VPingState + ":" + !IPValue + "]"
.MoveNext
Loop
End With
With Me.Adodc2.Recordset
.AddNew
!Cmd = "P"
!IPCode = 0
!PktDate = Format(Date, "YY/MM/DD")
!PktTime = Format(Time, "HH:MM:SS")
!PktStr = SumPinging
!OK = 0
.Update
End With
End If
' For Send Packet To Main Server
Static CntTimer3 As Long
CntTimer3 = CntTimer3 + 1
If CntTimer3 = IIf(RunFTP = 0, 2, 1) Then
CntTimer3 = 0
If RunFTP = 0 + 10 And IIf(PacketSet.InetTime = 0, False, Abs(ProcTimer - Timer) >= PacketSet.InetTime) Then
Me.BInet.Cancel
RunFTP = 0
End If
LFileName = PacketSet.Path + PacketSet.FileName
If Me.BInet.StillExecuting Then
Exit Sub
End If
Me.StatusBar1.Panels(1).Text = LastCommand
Select Case RunFTP
Case 0 ' Test Ack File From FTP
ProcTimer = Timer
Me.CLabel.BackColor = RGB(255, 100, 100)
Me.CLabel.Caption = "Test Ackn"
On Error Resume Next
Call DelFile(LFileName + ".ACK")
LastCommand = "GET " + PacketSet.FileName + ".ACK " + LFileName + ".ACK"
Me.BInet.Execute , LastCommand
On Error GoTo 0
RunFTP = 0 + 10
Case 1 ' Create Packet File From DataBase
ProcTimer = Timer
Me.CLabel.BackColor = RGB(255, 255, 0)
Me.CLabel.Caption = "Create Packet"
RunFTP = IIf(CPacketFile(), 2, 0)
Case 2 ' Send Packet File To FTP
ProcTimer = Timer
Me.CLabel.BackColor = RGB(0, 255, 0)
Me.CLabel.Caption = "Send Packet"
On Error Resume Next
LastCommand = "PUT " + LFileName + ".TXT " + PacketSet.FileName + ".TXT"
Me.BInet.Execute , LastCommand
On Error GoTo 0
Case 3 ' Create Ack File From DateTime
ProcTimer = Timer
Me.CLabel.BackColor = RGB(255, 255, 0)
Me.CLabel.Caption = "Create Ackn"
If CAckFile() Then
RunFTP = 4
End If
Case 4 ' Send Ack File To FTP
ProcTimer = Timer
Me.CLabel.BackColor = RGB(0, 255, 0)
Me.CLabel.Caption = "Send Ackn"
On Error Resume Next
LastCommand = "PUT " + LFileName + ".ACK " + PacketSet.FileName + ".ACK"
Me.BInet.Execute , LastCommand
On Error GoTo 0
End Select
End If
End2:
If Err.Number <> 0 Then End
End Sub
Private Function CPacketFile() As Boolean
CPacketFile = False
Call RunSP("CreatePacket")
Me.Adodc4.RecordSource = "GetPacket"
Me.Adodc4.Refresh
If Me.Adodc4.Recordset.RecordCount <= 0 Then
Exit Function
End If
Me.StatusBar1.Panels(2).Text = "Time=" + Format(Time, "HH:MM:SS") + " , Record = " & Me.Adodc4.Recordset.RecordCount
On Error GoTo PacketFile
LFileName = PacketSet.Path + PacketSet.FileName + ".TXT"
Open LFileName For Output As #1
Do While Not Me.Adodc4.Recordset.EOF
Print #1, Me.Adodc4.Recordset!Cmd + IIf(Me.Adodc4.Recordset!Cmd = "P", Me.Adodc4.Recordset!PktDate + Me.Adodc4.Recordset!PktTime, SetZero(Me.Adodc4.Recordset!IPCode, 3)) + Me.Adodc4.Recordset!PktStr
Me.Adodc4.Recordset.MoveNext
Loop
Close #1
CPacketFile = True
PacketFile:
End Function
Private Function CAckFile() As Boolean
CAckFile = False
LFileName = PacketSet.Path + PacketSet.FileName + ".ACK"
Call DelFile(LFileName)
On Error GoTo AckFile
Open LFileName For Output As #1
Print #1, "PUT=" + Format(Date, "YY/MM/DD") + Format(Time, "HH:MM:SS")
Close #1
CAckFile = True
AckFile:
End Function
Private Function GetAckFile() As Boolean
GetAckFile = False
LFileName = PacketSet.Path + PacketSet.FileName + ".ACK"
On Error GoTo GAckFile
If Dir(LFileName) <> "" Then
Open LFileName For Input As #1
CntLine = 0
Do While Not EOF(1)
Line Input #1, GetAckString
CntLine = CntLine + 1
If UCase(Mid(GetAckString, 1, 3)) = "GET" Then
GetAckFile = True
Exit Do
End If
Loop
Close #1
If CntLine = 0 Then
GetAckFile = True
End If
End If
GAckFile:
End Function
Private Sub RunSP(ByVal YourSP As String)
Dim TmpCon As ADODB.Connection
Set TmpCon = New ADODB.Connection
TmpCon.Open Me.Adodc1.ConnectionString
TmpCon.Execute YourSP
End Sub

[Mbt925]

همه ی ابزارهای دانلودی که وجود داره توسط برنامه نویس کنترل میشن و هیچ کدوم دارای پنجره نیسن.
اگه می بینید بعضی برنامه ها برای دانلود پنجره ای رو نشون میده ، این کار توسط برنامه نویس اونا انجام شده، برای اینکه اطلاعات دانلود در حال انجام به کاربر نشون داده بشه.

چندین روش و ابزار برای دانلود در تاپیک زیر معرفی شده:

http://barnamenevis.org/forum/showthread.php?t=78376&page=24

[مهران رسا]

والا من که هرچی شما رو نصیحت کردن فایده ای نداشت و ظاهراً مدیر بخش هم از این نوع نصیحت ها خوششون نمیاد !

استفاده از تابع URLDownloadToFile ساده ترین راه هست !

این ها رو توی قسمت General کپی کن !


Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long

Public Function DownloadFile(URL As String, _
LocalFilename As String) As Boolean: Dim lngRetVal As Long
lngRetVal = URLDownloadToFile(0, URL, LocalFilename, 0, 0)
If lngRetVal = 0 Then DownloadFile = True
End Function


اینم واسه دانلود کردن فایل :


Ret = DownloadFile("http://gksoft.persiangig.ir/EXIS_Sopports/Updates.ini", App.Path & "\Updates.ini")