PureBasic Forums - English

Code: Select all

;
; Last backup on    2014-02-25 at 14-15-14   into ZIP:   D:\ProgramFiles(x86)\PureBasic\MyFiles\Tools\BackUp_SourceFileToPureZip_zOld\zOld.zip
;
;{ SourceInfo =======================================================================================================
; App/Lib-Name:     My ZIP-BackUp solution
; Created on:       2014-02-23  23:13
; Version:          0.8.0a
; Author:           EfDschoma
; Compiler:         PureBasic 5.21
; Purpose:          I do not need a sophisticated versioning, but a regular backup of the file is of course necessary.
;                   My first approach was to saved the files (with current date and extension '.BU' in the same
;                   directory (or a subdirectory). This had the disadvantage that a 'search in files' brought up a a
;                   lot of (unwanted) results from these '.BU'-files.
;                   That's why I've written this little tool that saves the current source file (with current date in a
;                   Zip-file named 'zOld.zip'.
; Usage:            Create an executable of this toool and integrate this tool with -> Tools -> Configure tools -> New
;                   with the following parameters and you can create an easy backup at your fingertip.
;                   !!! Use UTF8 for your source files ( Select -> File -> File format -> Encoding: utf8)
;   Commandline:    Path to exe
;   Arguments:      1.param (obligatory) "%FILE"     (use it always within double quotes)
;                   2.param (optionally) noSuccessMsg - Dont show a message about success (Standard is showSuccessMsg)
;                   3.param (optionally) noComment    - Write success (like line 2) into SourceFile (Std is noComment)
;                   The order of the optionally parameters (2. + 3.) does not matter
;   Name:           BackUp SourceFile to zOld
;   Event Trigger:  Menu Or ShortCut
;   Shortcut:       CTRL + U
; Warning:          Save your source file before backup it. I am looking for a solution to do this programatically.
;                   I tested this tool in a variety of situations in my development environment. However I take no  
;                   responsibility for the fulfillment and/or of any purpose or for the effects which fail anyway. No matter 
;                   wether it is a mere malfunction or it is data loss of any kind. In particular the behavior of Ascii
;                   or Utf8 and other formats ist not specifically tested.
;                   Although I think this tool is useful, control exactly the effects in your development environment
;                   and see this merely as a programming template.
; ===================================================================================================================
;}

  EnableExplicit

  UseZipPacker()

  ;< Globals
  Global.i testMode    = #False   ;   #True   #False
  Global.l WindowID    = Val( GetEnvironmentVariable( "PB_TOOL_MAINWINDOW" ) )
  Global.l ScintillaID = FindWindowEx_( WindowID, 0, "Scintilla", 0)
  Global.s buAnnex,   buDate,    buExt = "BU", buNotice       = "; " + "Last backup on"
  Global.s buTime,    buZip,     param2,       param3,        zipFileName,  newTxt$
  Global.s PbLng,     sourceExt, sourceFile,   sourceFileExt, sourcePath,   sourcePathFile, successMsg
  Global.i SciFormat, nPack1,    nPack2,       showSuccessMsg = #True,      writeComment = #True
  ;>

  ;< Get program parameters + preferences, check and processed these
  sourcePathFile   = ProgramParameter()
  param2           = ProgramParameter()
  param3           = ProgramParameter()
  If LCase(param2) = "nosuccessmsg" Or LCase(param3) = "nosuccessmsg"
    showSuccessMsg = #False
  EndIf
  If LCase(param2) = "noComment" Or LCase(param3) = "noComment"
    writeComment   = #False
  EndIf
  ;>

  Procedure SendIdeMsg( SciMsg, p1, p2 )
    If ScintillaID
      SendMessage_( ScintillaID, SciMsg, p1, p2 )
    EndIf
  EndProcedure

  Procedure SendIdeTxt( Message.s )
    Protected ProcessID, PID, Length, Format, *Buffer, *MemoryID

    If ScintillaID
      If GetWindowThreadProcessId_( WindowID, @PID)
        ProcessID = OpenProcess_(#PROCESS_ALL_ACCESS, #False, PID )
        If ProcessID
          Select SendMessage_( ScintillaID, #SCI_GETCODEPAGE, #Null, #Null  )
            Case 0     : Format = #PB_Ascii
            Case 65001 : Format = #PB_UTF8
          EndSelect

          Length  = StringByteLength(Message, Format)
          *Buffer = AllocateMemory(Length + SizeOf(Character))
          If *Buffer
            PokeS(*Buffer, Message, -1, Format)
            *MemoryID = VirtualAllocEx_(ProcessID, #Null, Length, #MEM_RESERVE|#MEM_COMMIT, #PAGE_EXECUTE_READWRITE )
            If *MemoryID
              WriteProcessMemory_( ProcessID, *MemoryID, *Buffer, Length, #Null )
              ;Tried possible constants...
              ;V0 SendMessage_( ScintillaID, #SCI_ADDTEXT, Length, *MemoryID )                             - works, but adds only, does not replace the selection
              ;V1 SetClipboardText( Message ) : SendMessage_( ScintillaID, #SCI_PASTE, Length, *MemoryID ) - works, replace the selection, by the trick with the clipboard
              ;V2
              SendMessage_( ScintillaID, #SCI_REPLACESEL, Length, *MemoryID )
              ;-----------------
              VirtualFreeEx_(ProcessID, *MemoryID, Length, #MEM_RELEASE)
            EndIf

            FreeMemory(*Buffer)
          EndIf
          CloseHandle_(ProcessID)
        EndIf
      EndIf
    EndIf
  EndProcedure

  ;< Language Procedure and Definitions

  Procedure.s GetPbPrefStr( GroupName.s, Keyword.s, DefaultValue.s = "" )
    Protected.s currentLanguage, FileName = GetEnvironmentVariable("APPDATA") + "\PureBasic\PureBasic.prefs"
    If OpenPreferences( FileName, #PB_Preference_NoSpace | #PB_Preference_GroupSeparator )
      PreferenceGroup( GroupName )
      currentLanguage = ReadPreferenceString ( Keyword, DefaultValue)
      ClosePreferences()
    EndIf
    ProcedureReturn currentLanguage
  EndProcedure

  PbLng =   GetPbPrefStr( "Global", "CurrentLanguage", "?" )
  Define.s lngNoSourceFile, lngFileBuSuccess, lngFileBuError, lngInNewZipFile, lngInExistingFile
  If      PbLng = "English"
    lngNoSourceFile   = "The source file doesn't exist. Either this" + #CRLF$ + #CRLF$  +
                        "- programm-code is not (yet) stored, or in the " + #CRLF$ +
                        "- tools configuration is no param %File specified!"
    lngFileBuSuccess  = "Source file backed up successfully"
    lngFileBuError    = "Error - Could not backup source file "
    lngInNewZipFile   = " (into new 'zOld.zip')"
    lngInExistingFile = " (into 'zOld.zip')"
  ElseIf PbLng = "Deutsch"
    lngNoSourceFile   = "Kein Source-Datei-Name vorhanden. Entweder wurde dieser" + #CRLF$ + #CRLF$  +
                        "- Programm-Code noch nicht (nie) gespeichert, oder es wurde " + #CRLF$ +
                        "- in Werkzeug-Konfiguration kein Programmparameter %File angegeben!"
    lngFileBuSuccess  = "Programm Code erfolgreich gesichert"
    lngFileBuError    = "Fehler - konnte Programm Code nicht sichern"
    lngInNewZipFile   = " (in neue 'zOld.zip')"
    lngInExistingFile = " (in 'zOld.zip')"
  EndIf

  ;>

  If sourcePathFile = ""                                      ; Only if the source file exists
    If testMode
      sourcePathFile = "D:\ProgramFiles(x86)\PureBasic\MyFiles\Tools\BackUp_SourceFileToPureZip_zOld\test.pb"
      ;sourcePathFile = "D:\ProgramFiles(x86)\PureBasic\MyFiles\Tools\BackUp_SourceFileToPureZip_zOld\test"
      ;showSuccessMsg = #False
      writeComment   = #True
    Else
      MessageRequester( "Info", lngNoSourceFile )
      End
    EndIf
  EndIf

  sourcePath    = GetPathPart( sourcePathFile )
  sourceFileExt = GetFilePart( sourcePathFile )
  sourceExt     = GetExtensionPart( sourcePathFile )
  sourceFile    = Left( sourceFileExt, Len( sourceFileExt ) -  Len( sourceExt ) )
  buZip         = sourcePath + "zOld.zip"
  buDate        = FormatDate( "%yyyy-%mm-%dd", Date() )
	buTime        = FormatDate( "%hh-%ii-%ss",   Date() )
	buAnnex       = buExt + " " + buDate + " at " + buTime
	newTxt$       = buNotice + "    " + buDate + " at " + buTime + "   into ZIP:   " + buZip
	
	If sourceExt  = ""
	  zipFileName = sourceFile + "." + buAnnex
	Else
	  zipFileName = sourceFile + buAnnex + "." + sourceExt
	EndIf
		
  If FileSize( buZip ) = -1                ; file doesnt exist, therefore create it
    nPack1 = CreatePack( #PB_Any, buZip )
    If AddPackFile( nPack1, sourcePathFile, zipFileName )
      successMsg = lngFileBuSuccess + lngInNewZipFile
    Else
      successMsg = lngFileBuError
    EndIf
    ClosePack( nPack1 )
  Else
    nPack2 = OpenPack( #PB_Any, buZip )
    If AddPackFile( nPack2, sourcePathFile, zipFileName )
      successMsg = lngFileBuSuccess + lngInExistingFile
    Else
      successMsg = lngFileBuError
    EndIf
    ClosePack( nPack2 )
  EndIf
  
  If writeComment  
    Define foundStartPos.i = 0, foundEndPos.i = 0, lineNr.i = 1
    Define aPos.i = 0, ePos.i = 0
    Define fileId = 1, CurPos.l = 0, rbStr.s, RetStr.s
  ; =================================================================================================
    If ReadFile( fileId, sourcePathFile )
      SciFormat = ReadStringFormat( 0 )
      Repeat
        CurPos  = FileSeek( fileId, Loc( fileId ) ) : rbStr   = Chr( ReadByte( fileId ) )
        If Asc( rbStr ) = 13
          lineNr + 1
          If aPos And Not ePos : ePos = CurPos - 2 : EndIf
        EndIf
        RetStr  + rbStr
        If FindString( RetStr, buNotice ) And Not aPos
          aPos = CurPos - Len( buNotice ) - 3
        EndIf
        If CurPos > 500 : Break : EndIf
      Until Eof( 0 )
      CloseFile( 0 )
    EndIf
    
    If ( aPos + ePos ) = 0
      newTxt$ = ";" + #CRLF$ + newTxt$ + #CRLF$ + ";" + #CRLF$
    Else
      newTxt$ + #CRLF$
    EndIf
     SendIdeMsg( #SCI_SETSELECTIONSTART, aPos, 0 )
     SendIdeMsg( #SCI_SETSELECTIONEND,   ePos, 0 )
     SendIdeTxt( newTxt$ )
  EndIf
     
  If showSuccessMsg
    MessageRequester( "Info", successMsg )
  EndIf

  End

Code: Select all

Procedure SendCmdKey( cmdKey, Key1 )
    keybd_event_( cmdKey, 0, 0, 0 )                 ; press cmdKey
      keybd_event_( Key1, 0, 0, 0 )                 ; press Key
      keybd_event_( Key1, 0, #KEYEVENTF_KEYUP, 0)   ; release Key
    keybd_event_( cmdKey, 0, #KEYEVENTF_KEYUP, 0)   ; release cmdKey
  EndProcedure
 
  SendCmdKey( #VK_CONTROL, #VK_S )