Проверка читабельности файла (r) SadStar

Учебно-тренировочная работа
Код:
; PureBasic Visual Designer v3.95 build 1485 (PB4Code)

Import "Kernel32.lib"
    SetFilePointerEx.i(*hFile,liDistanceToMove.q,*lpNewFilePointer,dwMoveMethod.l)
EndImport

;- Window Constants
;
Enumeration
  #Window_0
EndEnumeration

;- Gadget Constants
;
Enumeration
	#Text_0
	#Text_1
	#Text_Size
	#Text_2
	#Text_Count
	#Text_Msg
	#Text_Help
	#String_0
	#String_1
  #Button_Select
  #Button_Start
  #Button_Stop
  #Button_Help
  #ProgressBar_0
EndEnumeration

Global lWorkThreadStarted.b ; рабочий поток запущен
Global lWorkThreadStop.b ; команда на останов потока
Global nWorkThread.l
Global iSectorSize.i ;размер сектора в байтах - нужен для режима #FILE_FLAG_NO_BUFFERING
Define Filename$

Procedure.s GetSysErrorText(ErrCode)
	Define result.s=""
	*Memory = AllocateMemory (255)
	length = FormatMessage_ (#FORMAT_MESSAGE_FROM_SYSTEM, #Null, ErrCode, 0, *Memory, 255, #Null)
	result=PeekS (*Memory, length - 2)
	FreeMemory (*Memory)
	ProcedureReturn result
EndProcedure

Procedure FatalError() 
   Protected Result$, Line 
   
   Result$="FatalError(): " 
   Line = ErrorLine() 
   If Line>=0 
     Result$+" в строке "+Str(Line)+", файла: "+ErrorFile() 
   EndIf 
   
   Result$+" Ошибка типа: "+Chr(34)+ErrorMessage()+Chr(34) 
   
   MessageRequester("Фатальная ошибка выполнения", Result$, #PB_MessageRequester_Ok )
   End 
EndProcedure

Procedure SaveParams(IniFileName.s) ; сохранить параметры текущей сессии
; сохранить параметры программы
	If CreatePreferences(IniFileName)
    PreferenceGroup("Values")
    WritePreferenceString("File", GetGadgetText(#String_0) )
    ClosePreferences()
	EndIf	
EndProcedure

Procedure.s IntToTrain(In.q, FieldLen.i, delimiter.s) ; Входное число, длина поля ("триады"), разделитель триад
	tmp$=Str(In)
	tmpLen=Len(tmp$)
	dlmLen=Len(delimiter)
	NewLen=0
	; количество "триад" и новая длина
	FieldQty=Int(tmpLen/FieldLen)
	NewLen=FieldQty*FieldLen
	n=tmpLen % FieldLen
	If n>0
    FieldQty+1
    NewLen+n
	EndIf
	NewLen+(FieldQty-1)*dlmLen

	*Result=AllocateMemory(NewLen+1)
	FillMemory(*Result, NewLen+1)
	pr=0 ;pointer of result
	If n>0 ; перенос первой неполной триады
    CopyMemory(@tmp$, *Result, n)
    pr+n
    If FieldQty>1
    	CopyMemory(@delimiter, *Result+pr, dlmLen)
    	pr+dlmLen
    EndIf
	EndIf
	
	p=n+1 
	While p<tmpLen ; перенос полных триад
    CopyMemory(@tmp$+p-1, *Result+pr, FieldLen)
    pr+FieldLen
    If pr<NewLen
    	CopyMemory(@delimiter, *Result+pr, dlmLen)
    	pr+dlmLen    	
    EndIf
    p+FieldLen
	Wend
	ProcedureReturn PeekS(*Result , NewLen )

EndProcedure

Procedure getMyFile()
	Filename$ = OpenFileRequester("Выбрать файл для проверки", "", "Все файлы|*.*", 0)
	If Len(Filename$)>0
    SetGadgetText(#String_0,Filename$)
	EndIf
EndProcedure

Procedure showFileSize()
	Protected Filename$=GetGadgetText(#String_0)

	If Mid(Filename$,2,2)=":\" ;есть буква диска
    Protected SectorsPerCluster, BytesPerSector, NumberOfFreeClusters, TotalNumberOfClusters
    If GetDiskFreeSpace_( Mid(Filename$,1,3), @SectorsPerCluster, @BytesPerSector, @NumberOfFreeClusters, @TotalNumberOfClusters)
    	iSectorSize=BytesPerSector
    EndIf
	Else
    SetGadgetText(#Text_Msg, "Не могу опознать букву диска")
    ProcedureReturn 
	EndIf

	Protected Result.q = FileSize(GetGadgetText(#String_0))
	If Result<0
    SetGadgetText(#Text_Msg, "Файл не найден")
    SetGadgetText(#Text_Size, "")
	Else
    SetGadgetText(#Text_Size, IntToTrain(Result, 3, " "))
    SetGadgetText(#Text_Msg, "")
    DisableGadget(#Button_Start,0)
	EndIf
	SetGadgetText(#Text_Count, "")
	SetGadgetState(#ProgressBar_0, 100)
EndProcedure

Procedure Start(*Value)
	lWorkThreadStarted=#True
	SetGadgetText(#Text_Msg, "")
	;открыть файл
	File$=GetGadgetText(#String_0)
	Handle=CreateFile_(@File$,#GENERIC_READ,#FILE_SHARE_READ,0,#OPEN_EXISTING,#FILE_FLAG_NO_BUFFERING,0) 
	If Handle=#INVALID_HANDLE_VALUE 
    ErrCode=GetLastError_()
    SetGadgetText(#Text_Msg, "Ошибка открытия файла ErrCode="+Str(ErrCode)+":"+GetSysErrorText(ErrCode))
    CloseHandle_(Handle)
	Else
    DisableGadget(#Button_Start,1)
    DisableGadget(#Button_Stop,0)
    
    ;qFileSize.q=GetFileSize_(Handle, #NUL) ;длина файла
    qFileSize.q=0
    GetFileSizeEx_(Handle,@qFileSize)
    SetGadgetText(#Text_Size, IntToTrain(qFileSize, 3, " ")) ;Str(qFileSize))

    KSize=iSectorSize*256 ;размер буфера
    *Buffer1=AllocateMemory(KSize)
    If *Buffer1
    	nReaded.l=0 ;для возврата количества реально прочитаных байт
    	qCount.q=0 ;прочитано байт от начала файла
    	iOk.i=1 ;флаг успешного завершения операции
        While qCount<qFileSize
        	
        	If SetFilePointerEx(Handle, qCount, #NUL, #FILE_BEGIN) = 0
            ErrCode=GetLastError_()
            SetGadgetText(#Text_Msg, "Ошибка установки позиции чтения файла Err."+Str(ErrCode)+":"+GetSysErrorText(ErrCode))
        	EndIf
        	
        	If ReadFile_(Handle,*Buffer1,KSize,@nReaded,0) = 0
            ErrCode=GetLastError_()
            SetGadgetText(#Text_Msg, "Ошибка чтения файла. ErrCode="+Str(ErrCode)+":"+GetSysErrorText(ErrCode))
            iOk=0
            Break
        	EndIf
        	
 	          	qCount+nReaded
 	          	
 	          	SetGadgetState(#ProgressBar_0, Int(qCount/qFileSize*100))
        SetGadgetText(#Text_Count, Str(Int(qCount/qFileSize*100))+"% "+IntToTrain(qCount, 3, " ")) ;Str(qCount))
        
        If lWorkThreadStop ;прервать проверку
        	SetGadgetText(#Text_Msg, "Чтение файла прервано по требованию пользователя")
        	iOk=0
        	Break
        EndIf
        
    	Wend    
	
         FreeMemory(*Buffer1)
         If iOk
         	SetGadgetText(#Text_Msg, "Читабельность файла - Ok")
         EndIf

    Else
    	SetGadgetText(#Text_Msg, "Ошибка при выделении памяти под буфер. ErrCode="+Str(ErrCode)+":"+GetSysErrorText(ErrCode))
    EndIf
    CloseHandle_(Handle)
    
    DisableGadget(#Button_Start,0)
    DisableGadget(#Button_Stop,1)
    DisableGadget(#ProgressBar_0,1)
	EndIf
	lWorkThreadStarted=#False
EndProcedure

Procedure Open_Window_0()
  Protected Result.b= #False
  If OpenWindow(#Window_0, 281, 107, 570, 99, "Проверка читабельности файла (r) SadStar",  #PB_Window_SystemMenu | #PB_Window_TitleBar | #PB_Window_ScreenCentered)

      TextGadget(#Text_0, 10, 10, 50, 20, "Файл : ", #PB_Text_Right)
      StringGadget(#String_0, 60, 10, 440, 20, "")
      TextGadget(#Text_1, 10, 40, 50, 20, "Размер : ", #PB_Text_Right)
      TextGadget(#Text_Size, 60, 40, 110, 20, "0", #PB_Text_Right)
      TextGadget(#Text_2, 10, 60, 50, 20, "Считано : ", #PB_Text_Right)
      TextGadget(#Text_Count, 60, 60, 110, 20, "0", #PB_Text_Right)
      TextGadget(#Text_Msg, 180, 40, 320, 35, "0")
      SetGadgetColor(#Text_Msg, #PB_Gadget_FrontColor, #Red)

      
      ButtonGadget(#Button_Select, 510, 10, 50, 20, ". . .")
      ButtonGadget(#Button_Start, 510, 43, 50, 20, "Start")
      DisableGadget(#Button_Start,1)
      ButtonGadget(#Button_Stop, 510, 75, 50, 20, "Stop")
      DisableGadget(#Button_Stop,1)
      ProgressBarGadget(#ProgressBar_0, 60, 80, 440, 10, 0, 10, #PB_ProgressBar_Smooth )
      SetGadgetAttribute(#ProgressBar_0, #PB_ProgressBar_Minimum, 0)
      SetGadgetAttribute(#ProgressBar_0, #PB_ProgressBar_Maximum, 100)
      SetGadgetState(#ProgressBar_0, 100)
      DisableGadget(#ProgressBar_0,1)
      ButtonGadget(#Button_Help, 5, 75, 50, 20, "???" , #PB_Button_Toggle)
      
      TextGadget(#Text_Help, 60, 100, 440, 140, "TextGadget Border", #PB_Text_Border)
      Text$="Эта утилита проверяет читабельность файла с носителя."+#CRLF$
      Text$+"Просто читает файл от начала и до конца."+#CRLF$
      Text$+"Если попадется 'битый' участок файла - остановится по ошибке."+#CRLF$
      Text$+"Обычно я проверял читабельность файлов (например - киношки на CD/DVD) методом копирования."+#CRLF$
      Text$+"Но для больших файлов нужно большое место для приема файлов."+#CRLF$
      Text$+"Да еще антивирус кидается его проверять..."+#CRLF$
      Text$+"Т.ч. с этой утилитой будет проще жить."+#CRLF$
      Text$+"20/06/2012"+#CRLF$
      Text$+"SadStar"+#CRLF$
      SetGadgetText(#Text_Help, Text$)
      
	Result=#True
  EndIf
  ProcedureReturn Result
EndProcedure

OnErrorCall(@FatalError())
 
ProgName$ = ProgramFilename() ;полное имя файла самой исполняемой программы
IniFileName$ = Left(ProgName$, Len(ProgName$)-3)+"ini" ;полное имя ini-файла

If Not Open_Window_0(): End: EndIf
;{ Восстановление параметров
If OpenPreferences(IniFileName$)
	If PreferenceGroup("Values")
    ; восстанавливаем параметры последнего сеанса работы с программой
    SetGadgetText(#String_0, ReadPreferenceString("File", ""))
	EndIf
	ClosePreferences()
EndIf
;}

showFileSize()

;{- Event loop
Repeat
	Event = WaitWindowEvent() ; ждать события
	EventWindow = EventWindow() ; какое окно поимело событие
	Select Event
    	; ------------------------------
    Case #PB_Event_Gadget
    	EventGadget = EventGadget()
    	EventType = EventType()
    	If EventGadget = #Button_Select
        getMyFile()
        showFileSize()
    	ElseIf EventGadget = #Button_Start
        	; запустить поток обработки
        	lWorkThreadStarted=#False
        	lWorkThreadStop=#False
        	nWorkThread = CreateThread(@Start(), 0)
        	If Not nWorkThread
            SetGadgetText(#Text_Msg, "Поток обработки не создан. ErrCode="+Str(ErrCode)+":"+GetSysErrorText(ErrCode))
        	EndIf
    	ElseIf EventGadget = #Button_Stop
        	; остановить поток обработки
        	lWorkThreadStop=#True
    	ElseIf EventGadget = #Button_Help
        If GetGadgetState(#Button_Help) 
        	ResizeWindow(#Window_0, #PB_Ignore, #PB_Ignore, #PB_Ignore, WindowHeight(#Window_0) +150) 
        Else
        	ResizeWindow(#Window_0, #PB_Ignore, #PB_Ignore, #PB_Ignore, WindowHeight(#Window_0) -150)
        EndIf

    	EndIf
    	; ----------------------------

    Case #PB_Event_CloseWindow
    	If EventWindow = #Window_0
        SaveParams(IniFileName$)
        If lWorkThreadStarted And IsThread(nWorkThread)
        	KillThread(nWorkThread)
        EndIf
        CloseWindow(#Window_0)
        Break
    	EndIf
	EndSelect
ForEver
;}

End
PureBasic - форум

Меню навигации

Пользовательские ссылки

Информация о пользователе

Проверка читабельности файла (r) SadStar

Сообщений 1 страница 1 из 1

Поделиться122.06.2012 07:49:33
