| View previous topic :: View next topic |
| Author |
Message |
kefirux
Joined: 09 Dec 2008
Posts: 20
|
 (Separately) Posted: Thu Dec 11, 2008 00:14 Post subject: |
 |
|
Volniy
кстати спасибо за кусок кода копирования, это толчок к созданию
этого самого окошка) всё представляю как сделать кроме отображения скорости передачи |
|
| Back to top |
|
 |
kefirux
Joined: 09 Dec 2008
Posts: 20
|
| (Separately) Posted: Thu Dec 11, 2008 00:20 Post subject: |
|
|
о, чёто я туплю. надож просто посчитать сколько он скопировал за одну секунду. так что это тоже можно сказать сделанно. хотя это уже не под формат форума  |
|
| Back to top |
|
|
kefirux
Joined: 09 Dec 2008
Posts: 20
|
| (Separately) Posted: Fri Dec 12, 2008 00:46 Post subject: |
|
|
ну вот сделал версию без участия Тотала (простите старого еретика)
большая проблема в том что ну вот не нашёл я в ВБ не то что прогресс бара, но даже модального окна. сделал прогресс бар с подгрузкой IE
тут я вспомнил о такой вещи как многопоточность ) потому что надо както чтобы один поток копировал а другой отображал ход действий. но я это решил тем что запускается второй ВБскрипт из первого
основная прога:
| Code: |
'Option Explicit
Dim WshShell
Dim RetCode
Dim fso
Dim StartFolder
Dim str
Dim M1
Dim FItem
Dim Answer
Dim curFolder, curFolder2
Set WshShell = CreateObject("WScript.Shell")
str=InputBox("Введите имя папки","Имя Папки",Date,vbOK)
Set fso = CreateObject("Scripting.FileSystemObject")
If Not fso.FolderExists("X:\- ПАКИ ФОТОСЕТОВ\" & str) Then
fso.CreateFolder("X:\- ПАКИ ФОТОСЕТОВ\" & str)
End If
StartFolder = "F:/Dcim"
If fso.FolderExists(StartFolder) = False Then
MsgBox "какаято ошибка!", vbCritical
WScript.Quit
End If
Set curFolder = fso.GetFolder(StartFolder)
RetCode = WshShell.Run("""G:\KefiR\Pack\VB\ProgressBar.vbs"" " & str , 1, False)
For Each FItem In curFolder.SubFolders
fso.CopyFile FItem.Path & "\*.*", "X:\- ПАКИ ФОТОСЕТОВ\" & str
Next
WScript.Sleep 1000
WScript.Quit
|
второй поток (ProgressBar.vbs)
| Code: |
Option Explicit
Dim fso
Dim StartFolder
Dim curFolder, curFolder2
Dim RetCode, objArgs
Dim gdocProgressBar 'Required global declaration for status bar document
Dim goieProgressBar 'Required global declaration for Internet Explorer object
Set gdocProgressBar = Nothing
Set goieProgressBar = Nothing
Set objArgs = WScript.Arguments
Set fso = CreateObject("Scripting.FileSystemObject")
StartFolder = objArgs(0)
MsgBox StartFolder
StartFolder = "X:\- ПАКИ ФОТОСЕТОВ\" & StartFolder
Set curFolder2 = fso.GetFolder("F:\Dcim")
Set curFolder = fso.GetFolder(StartFolder)
Do
Set curFolder = fso.GetFolder(StartFolder)
ProgressBar curFolder.Size/(curFolder2.Size/100)
WScript.Sleep 100
Loop While curFolder.Size <> curFolder2.Size
answer = msgbox(StartFolder & " " & curFolder2.Size & " => " & curFolder.Size & vbNewLine & "=========================" & vbNewLine & "Запустить Lightroom?", vbOkCancel)
if answer=vbOk then RetCode = WshShell.Run("""E:\Program Files\Adobe\Adobe Photoshop Lightroom 2\lightroom.exe"" """ & StartFolder & """", 0, False)
ProgressBar -1
WScript.Quit
Sub ProgressBar(intPercent)
'Requires global declaration for gdocProgressBar and goieProgressBar
'Creates an html page showing a status bar.
'intPercent must be between 0 and 100.
'If intPercent is out of range, the status bar is shut down.
'Create the status bar window
If gdocProgressBar Is Nothing Then
If ((Cint(intPercent) >= 0) And (Cint(intPercent) <= 100)) Then
Set goieProgressBar = CreateObject("InternetExplorer.Application")
goieProgressBar.Offline = True
goieProgressBar.AddressBar = False
goieProgressBar.Height = 100
goieProgressBar.Width = 250
goieProgressBar.MenuBar = False
goieProgressBar.StatusBar = False
goieProgressBar.Silent = True
goieProgressBar.ToolBar = False
goieProgressBar.Navigate "about:blank"
Do While goieProgressBar.Busy
WScript.Sleep 100
Loop
'On Error Resume Next
Set gdocProgressBar = Nothing
Do Until Not gdocProgressBar Is Nothing
WScript.Sleep 100
Set gdocProgressBar = goieProgressBar.Document
Loop
gdocProgressBar.Open
gdocProgressBar.Write "<html><head><title>"
gdocProgressBar.Write "Copy"
gdocProgressBar.Write "</title></head><body><center>"
gdocProgressBar.Write "<TABLE width=200 border=3 frame=box><tr><td>"
gdocProgressBar.Write "<TABLE id=status width=0 border=0 cellpadding=0 cellspacing=0 bgcolor=#FFFFFF>"
gdocProgressBar.Write "<tr><td> </td></tr></table></td></tr></table></center></body></html>"
gdocProgressBar.Close
goieProgressBar.Visible = True
Else
Exit Sub
End If
End If
'Close the status bar window
If Not gdocProgressBar Is Nothing Then
If ((Cint(intPercent) < 0) Or (Cint(intPercent) > 100)) Then
goieProgressBar.Visible = False
Set gdocProgressBar = Nothing
goieProgressBar.Quit
Set goieProgressBar = Nothing
Exit Sub
End If
End If
'Update the status bar window
If Cint(intPercent) = 0 Then
gdocProgressBar.all.status.width = "1%"
gdocProgressBar.all.status.bgcolor = "#FFFFFF"
Else
gdocProgressBar.all.status.width = Cstr(Cint(intPercent)) & "%"
gdocProgressBar.all.status.bgcolor = "#339955"
End If
End Sub
|
класс прогресс бара честно украл на просторах интернета |
|
| Back to top |
|
|
kefirux
Joined: 09 Dec 2008
Posts: 20
|
| (Separately) Posted: Fri Dec 12, 2008 17:37 Post subject: |
|
|
я полазил везде и понял что это не выполняемо )
поэтому я написал свою версию на полноценном языке:
причём если нужно кому, могу код кинуть и сам exe,
так как она универсальная, я её запускаю из ВБскрипта, а во входящих параметрах указывается два пути "откуда" и "куда"
но оно не копирует! оно просто следит за размерами этих папок и высчитывает прогресс |
|
| Back to top |
|
|
taravasya
Joined: 27 Mar 2010
Posts: 38
|
| (Separately) Posted: Sat Sep 18, 2010 01:27 Post subject: |
|
|
kefirux
Мне пригодился бы такой код...  |
|
| Back to top |
|
|
|
|
You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum
You cannot vote in polls in this forum
|
Powered by phpBB © 2001, 2005 phpBB Group
|
Rules
Search
FAQ
Memberlist
Usergroups
Register
Profile
Log in to check your private messages
Log in
