Jump to content

SUBIECTE NOI
« 1 / 5 »
RSS
Spital privat refuza sa ofere fi&...

Avem canicula la Constanta vara?

Vreau sa schimb Motorul la tracto...

Smartphone Nokia sau Motorola cu ...
 Revizie centrala termina

Reciverul digi tv

La multi ani @nick5roo!

"Seven Seconds"
 Incercare bonsai, ce sa tai ?

Cum sa apara poze cu data,ora ?&#...

Spider-Man: Across the Spider-Verse

Acoperis terasa demontabil
 nivelare teren la intrare poarta

Prelungire conductori in interior...

motor iveco cu turbo

Curatare sifon condens centrala A...
 

VBS pentru descarcare fisiere

- - - - -
  • Please log in to reply
No replies to this topic

#1
lucs

lucs

    Member

  • Grup: Members
  • Posts: 258
  • Înscris: 21.07.2005
Cu respect, va salut !

Scriptul de mai jos ia niste fisiere de pe un server si le muta in alta parte. As vrea sa poata lua doar fisierele cu extensia .ZIP sau .PDF (si in log sa scrie si dimensiunea fisierelor pentru ca apoi sa le poata sterge comparand), sa-i pot da in loc de Schema.pdf,Cerere.doc - *.pdf,*.doc. Se poate ? Ma ajuta cineva ?
Multumesc !


PS In loc de & #39;* este '*.
 '****************************************************************************
********************
' Download.vbs - Descarcare de fisiere 
'****************************************************************************
********************
Option Explicit
On Error Resume Next

Dim LogPath, SourceURL, TargetPath, Files2Download

'****************************************************************************
********************
'			Aici sunt variabilele de editat!
'****************************************************************************
********************
			'Unde salvez log-urile:
			LogPath = "C:\Documents and Settings\utilizator\Desktop\Loguri\"

			'De unde descarc:
			SourceURL = "http://192.168.1.99/locatie/dir/"
							
			'Unde salvez fisierele descarcate:
			TargetPath = "C:\Fisiere_de_pe_servaras\"
							
			'Ce fisiere descarc (separate de ','):
			Files2Download = "Schema.pdf,Cerere.doc"

'****************************************************************************
********************
	Main 'Run the main process
'****************************************************************************
********************
'Main process:
Sub Main
	Dim strOutputFile, strErrCode, strOutPut, i
	Dim objArgs, objFSO, objOutputFile, objHTTP
	Dim arrFiles2Download
	Const ForReading = 1, ForWriting = 2, ForAppending = 8
	arrFiles2Download = Split(Files2Download,",")
	strOutputFile = LogPath & "Log-Descarcare-" & Replace(Date,"/","-") & ".log"

	'Parse Arguments (from App. Center URL Health Monitor):
	Set objArgs = Wscript.Arguments
	For i = 0 To objArgs.count - 1
		strErrCode = strErrCode & objArgs(i) & " "
	Next
	Set objArgs = Nothing
	strOutPut = Now & " - " & strErrCode

	'Download files:
	For i = 0 To Ubound(arrFiles2Download)
		If SaveWebBinary(SourceURL & arrFiles2Download(i), TargetPath & arrFiles2Download(i)) Then
			'Download OK:
			strOutPut = strOutPut & vbCrLf & Now & " - Fisiere descarcate: " & arrFiles2Download(i)
		Else
			'Download Error
			strOutPut = strOutPut & vbCrLf & Now & " - N-am putut descarca: " & arrFiles2Download(i)
		End If
	Next
	'Write LogFile:
	Set objFSO = CreateObject("Scripting.FileSystemObject")
	Set objOutputFile = objFSO.OpenTextFile(strOutputFile, ForAppending, True)
	objOutputFile.Write "-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-" & vbCrLf
	objOutputFile.Write strOutPut & vbCrLf
	objOutputFile.Write "-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-" & vbCrLf
	objOutputFile.Close
	Set objFSO = Nothing
	Set objOutputFile = Nothing
End Sub
'****************************************************************************
********************
'Download the file from %strUrl% to %strFile% - returns True / False
Function SaveWebBinary(strUrl, strFile) 'As Boolean
	Const adTypeBinary = 1
	Const adSaveCreateOverWrite = 2
	Const ForWriting = 2
	Dim web, varByteArray, strData, strBuffer, lngCounter, ado
	Err.Clear
	Set web = Nothing
	Set web = CreateObject("WinHttp.WinHttpRequest.5.1")
	If web Is Nothing Then Set web = CreateObject("WinHttp.WinHttpRequest")
	If web Is Nothing Then Set web = CreateObject("MSXML2.ServerXMLHTTP")
	If web Is Nothing Then Set web = CreateObject("Microsoft.XMLHTTP")
	web.Open "GET", strURL, False
	web.Send
	If Err.Number <> 0 Then
		SaveWebBinary = False
		Set web = Nothing
		Exit Function
	End If
	If web.Status <> "200" Then
		SaveWebBinary = False
		Set web = Nothing
		Exit Function
	End If
	varByteArray = web.ResponseBody
	Set web = Nothing
	
	'Save the file
	On Error Resume Next
	Set ado = Nothing
	Set ado = CreateObject("ADODB.Stream")
	If ado Is Nothing Then
		Set fs = CreateObject("Scripting.FileSystemObject")
		Set ts = fs.OpenTextFile(strFile, ForWriting, True)
		strData = ""
		strBuffer = ""
		For lngCounter = 0 to UBound(varByteArray)
			ts.Write Chr(255 And Ascb(Midb(varByteArray,lngCounter + 1, 1)))
		Next
		ts.Close
	Else
		ado.Type = adTypeBinary
		ado.Open
		ado.Write varByteArray
		ado.SaveToFile strFile, adSaveCreateOverWrite
		ado.Close
	End If
	SaveWebBinary = True
End Function
'****************************************************************************
********************

Attached Files


Edited by lucs, 06 April 2006 - 11:47.


Anunturi

Second Opinion Second Opinion

Folosind serviciul second opinion ne puteți trimite RMN-uri, CT -uri, angiografii, fișiere .pdf, documente medicale.

Astfel vă vom putea da o opinie neurochirurgicală, fără ca aceasta să poată înlocui un consult de specialitate. Răspunsurile vor fi date prin e-mail în cel mai scurt timp posibil (de obicei în mai putin de 24 de ore, dar nu mai mult de 48 de ore). Second opinion – Neurohope este un serviciu gratuit.

www.neurohope.ro

0 user(s) are reading this topic

0 members, 0 guests, 0 anonymous users

Forumul Softpedia foloseste "cookies" pentru a imbunatati experienta utilizatorilor Accept
Pentru detalii si optiuni legate de cookies si datele personale, consultati Politica de utilizare cookies si Politica de confidentialitate