![]() |
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 |
VBS pentru descarcare fisiere
Last Updated: Apr 06 2006 11:46, Started by
lucs
, Apr 06 2006 11:46
·
0

#1
Posted 06 April 2006 - 11:46

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 FilesEdited by lucs, 06 April 2006 - 11:47. |
Anunturi
▶ 0 user(s) are reading this topic
0 members, 0 guests, 0 anonymous users