#post-id: 3329-04-01 #original-date: 6.09.2009 Sun #original-time: 4:01 AM #original-day: &#160;3329 #original-host: WinXP Prof SP2 (Build 2600) Стоит н...

понедельник, 07 сентября 2009

19:09

Тотальная неудачница и убийца жёстких дисков.

#post-id: 3329-04-01
#original-date: 6.09.2009 Sun
#original-time: 4:01 AM
#original-day: 3329
#original-host: WinXP Prof SP2 (Build 2600)

Стоит начать писать программу, как страсти закипают >_<

'====================================================================
' AJPapps - ScanDisk
' Линда Кайе 2009. Посвящается Ариэль
' 
' Этот скрипт предназначен для параноиков вроде меня, привыкших что 
' ScanDisk в Win9x спрашивает по любому поводу разрешения на 
' продолжение. Да-да, CHKDSK в Windows NT решает теже проблемы, но 
' никогда ни чего не спрашивает. В итоге он может вынести кучу папок 
' из-за единственной ошибки, и вам ни чего не скажет. Как узнать о 
' таких трагедиях? Сравнить состояние диска до и после проверки! Для 
' этого я написала маленький BAT файл, а потом переделала в этот 
' скрипт, чтобы немного облегчить работу с FAT32 томами...
' 
' ВНИМАНИЕ! Скрипт сравнивает файлы со списками при помощи 
' WinMerge. Другие программы не поддерживаются, но Вы можете сами 
' модифицировать код в функции StartWinMerge(). Если Вы всёже 
' используете WinMerge, то в константе WIN_MERGE_DIR нужно указать 
' полное имя файла программы. В моём случае указана заглушка 
' портабельной версии.
' 
' Скачать WinMerge можно отсюда:
' http://winmerge.org
' 
' ВНИМАНИЕ! Скрипт запустится и в Win9x, но работать там он будет 
' неправильно. Используйте вместо него программу ScanDisk.
' 
' TODO: Может быть генерировать BAT файл и запускать его. Тогда 
'       будет больший фидбэк...
' 
' • 6.09.2009
'   Первая версия ^^
' 
'====================================================================
' Маленький копирайт
' 
' 1. Программа и исходный код распространяются бесплатно.
' 2. Вы имеете право распространять их на тех же условиях.
' 3. Вы не имеете права использовать имя автора после модификации 
'    исходного кода.
' 4. При этом желательно указывать ссылку на автора оригинальной 
'    версии исходного кода.
' 5. Вы не имеете права на платное распространение исходного кода, 
'    а также программных модулей, содержащих данный исходнй код.
' 6. Программа и исходный код распространяются как есть. Автор не 
'    несёт ответственности за любые трагедии или несчастные случаи, 
'    вызванные использованием программы и исходного кода.
' 7. Для любого пункта данного соглашения может быть сделано 
'    исключение с разрешения автора программы.
' 8. По любым вопросам, связанным с данной программой, обращайтесь 
'    по адресу lindaoneesama@gmail.com
' 
' Загружено с http://purl.oclc.org/Linda_Kaioh/Homepage/
'====================================================================
Option Explicit

Const AppTitle = "AJPapps - ScanDisk"
Const TemporaryFolder = 2
Const SW_SHOWDEFAULT = 10
Const SW_HIDE = 0

' Модифицруйте эту константу чтобы указать расположение WinMerge.
Const WIN_MERGE_DIR = "I:\Utils.Portable\WinMergePortable\WinMergePortable.exe"

Dim FSO
Dim TempPath
Dim List1
Dim List2
Dim SourceDrive

Set FSO = CreateObject("Scripting.FileSystemObject")

' Получаем аргументы...
GetAndParseArguments

' Получаем имена файлов для списков...
TempPath = FSO.GetSpecialFolder(TemporaryFolder)
List1 = FSO.BuildPath(TempPath, "{8702d814-5dc8-4212-9aff-79b879af1406}.TXT")
List2 = FSO.BuildPath(TempPath, "{169e5285-c362-47d5-b9ea-d36dfbe5ab74}.TXT")

' Создаём первый список...
MakeList List1, SourceDrive

' Стартуем CHKDSK...
StartChkDsk SourceDrive

' Создаём второй список...
MakeList List2, SourceDrive

' А теперь стартуем WinMerge...
StartWinMerge List1, List2

'MsgBox "Файлы списокв отались во временном каталоге. " & _
'       "На всякий пожарный." & vbCrLf & vbCrLf & _
'       List1 & vbCrLf & vbCrLf & _
'       List2, vbInformation, AppTitle

'====================================================================
Private Sub GetAndParseArguments()
  If WScript.Arguments.Count <> 1 Then
    ShowUsage
    WScript.Quit
  End If
  
  SourceDrive = WScript.Arguments(0)
  SourceDrive = Trim(SourceDrive)
  SourceDrive = UCase(SourceDrive)
  
  If Len(SourceDrive) <> 2 Then
    ShowUsage
    WScript.Quit
  End If
  
  If Right(SourceDrive, 1) <> ":" Then
    ShowUsage
    WScript.Quit
  End If
  
  If InStr("ABCDEFGHIJKLMNOPQRSTUVWXYZ", Left(SourceDrive, 1)) = 0 Then
    ShowUsage
    WScript.Quit
  End If
End Sub

'====================================================================
Private Sub ShowUsage()
  MsgBox "Использование:" & vbCrLf & vbCrLf & _
         "ScanDisk.VBS Volume:" & vbCrLf & vbCrLf & _
         "Проверить диск (Volume) на ошибки и сравнить содержимое " & _
         "до проверки с содержимым после проверки.", _
         vbInformation, AppTitle
End Sub

'====================================================================
Private Sub MakeList(ByVal FileName, ByVal Drive)
  Dim SH
  Set SH = WScript.CreateObject("WSCript.Shell")
  
  On Error Resume Next
  
  SH.Run "CMD /C DIR /S /A " & Drive & "\*.* > """ & FileName & """", SW_HIDE, True
  If Err Then ErrorDisplay "Не удалось запустить Dir."
End Sub

'====================================================================
Private Sub StartChkDsk(ByVal Drive)
  Dim Cmd
  Dim SH
  Dim oExec
  
  On Error Resume Next
  
  If UCase(FSO.GetDrive(Drive).FileSystem) = "NTFS" Then
    Cmd = "CMD /C CHKDSK /V /F " & Drive & " & PAUSE"
  Else
    Cmd = "CMD /C CHKDSK /F " & Drive & " & PAUSE"
  End If
  
  Set SH = WScript.CreateObject("WSCript.Shell")
  SH.Run Cmd, SW_SHOWDEFAULT, True
  
  If Err Then ErrorDisplay "Не удалось запустить ChkDsk."
End Sub

'====================================================================
Private Sub StartWinMerge(ByVal List1, ByVal List2)
  Dim SH
  Set SH = WScript.CreateObject("WSCript.Shell")
  
  On Error Resume Next
  
  SH.Run """" & WIN_MERGE_DIR & """ """ & List1 & """ """ & List2 & """", SW_SHOWDEFAULT, True
  If Err Then ErrorDisplay "Не удалось запустить WinMerge."
End Sub

'====================================================================
Private Sub ErrorDisplay(ByVal Text)
  MsgBox Text, vbCritical, AppTitle
End Sub

URL

Поделиться

так не хочется заниматься на работе тем чему тебя не учил... Я совсем недвно узнала об этом дневнике.... порой кажетьс... Побывал как-то в трапезной буддийского монастыря. Крайне ...

Пытаясь влиться в круг волчиц Невольно подумай о жизни ... Что я могу сказать... 1:1 И ведь красиво так забили, ... Порой собственные воспоминания кажутся принадлежащими ком...

Комментарии


Запомнить

Лингрин :: Резиденция Линды Кайе