Hi, I have just got a DVD burner and am starting to look at modifing my previous code to add the facility to burn DVDs. I have done a nero update to 6.6.0.1 and see there is a new media type NERO_MEDIA_DVD_P_R9 I guess this is the dual layer format?

I can`t find it in the sdk 1.05 manual, I tried to see if there was a new version to download but the download sdx link on the nero website doesn`t seem to work? (Tried mozilla firefox and IE, IE does not, Firefox opens a new window but sits there loading forever?).

Mike

Tried right-click and save as in IE and get a download window then the attached message box

Sorry didn`t attach before - file was too large, had to save in 256 colour

Correct! This is a Double Layer DVD.

Got DVD working OK. Code follows for anyone interested:

Option Explicit

' load references
Public WithEvents Nero As Nero
Public WithEvents Drive As NeroDrive

' variable for holding number of existing sessions on disc when cd info read
Dim NumExistingTracks As Integer

'flag for checking if drive event finished
Dim DriveFinished As Boolean

' list of available drives
Dim Drives As INeroDrives

Dim CANCELPRESSED As Boolean

' main folder to be burnt
Dim Folder As INeroFolder

' main track to be burnt
Dim ISOTrack As NeroISOTrack

Private Sub AddMessage(ByVal Message As String)
lst_Messages.AddItem Message
If lst_Messages.ListCount <> 0 Then
lst_Messages.ListIndex = lst_Messages.ListCount - 1
lst_Messages.Refresh
End If
End Sub

' function for removing extra spaces and lines from messages
Private Sub SplitText(ByVal Data As String)
Dim Temp As String
Dim I As Integer

Temp = ""
For I = 1 To Len(Data)
If Mid$(Data, I, 1) = Chr$(13) Then
lst_Messages.AddItem Trim$(Temp)
Temp = ""
ElseIf Mid$(Data, I, 1) <> Chr$(10) Then
Temp = Temp + Mid$(Data, I, 1)
End If
Next
If Temp <> "" Then
AddMessage Trim$(Temp)
End If

End Sub

'Recursive function to build the Folders/Files to burn
Private Sub BuildFileFolderTree(ByRef nroFolderToUse As NeroFolder, ByRef folCurrent As Folder)
Dim folTMP As Folder
Dim filTMP As File
Dim nroFolTmp As NeroFolder
Dim nroFilTmp As NeroFile

'Add all files in the current directory
For Each filTMP In folCurrent.Files
Set nroFilTmp = New NeroFile
nroFilTmp.Name = filTMP.Name
nroFilTmp.SourceFilePath = filTMP.Path
nroFolderToUse.Files.Add nroFilTmp
Next

'Write the sub folders
For Each folTMP In folCurrent.SubFolders
Set nroFolTmp = New NeroFolder
nroFolTmp.Name = folTMP.Name
nroFolderToUse.Folders.Add nroFolTmp
Call BuildFileFolderTree(nroFolTmp, folTMP)
Next

End Sub

Private Sub chk_prompt_Click()

If chk_prompt.Value = 1 Then
Lab_days_remaining.Visible = True
Lab_days_remaining_text.Visible = True
Lab_days_remaining.Caption = Cbo_days.Text
Else
Lab_days_remaining.Visible = False
Lab_days_remaining_text.Visible = False
If Len(Dir$("c:\unison\promptbackup.Dat")) <> 0 Then
If Not PutUnisonKeyLong("Prompt Backup", 0) Then
MsgBox "Error Accessing Registry!"
Exit Sub
End If

If Not PutUnisonKeyString("Prompt Backup Date", "") Then
MsgBox "Error Accessing Registry!"
Exit Sub
End If

If Not PutUnisonKeyLong("Prompt Backup Remaining", 0) Then
MsgBox "Unable To Access Registry - Possible System Error!"
Exit Sub
End If
End If
Prompt_Backup_Days_Left = 0
End If

End Sub

Private Sub cmd_Eject_Click()
Set Drive = Drives(lst_AvailableDevices.ListIndex)
Drive.EjectCD
End Sub

Private Sub cmd_Exit_Click()
Dim backupfile As Integer
Dim promptfile As Integer
Dim datefile As Integer

On Local Error GoTo exit_form

If chk_prompt.Value = 1 Then

If Not PutUnisonKeyLong("Prompt Backup", Val(Cbo_days.Text)) Then
MsgBox "Error Accessing Registry!"
Exit Sub
End If

If Prompt_Backup_Days_Left > Val(Cbo_days.Text) Or Prompt_Backup_Days_Left = 0 Then
If Not PutUnisonKeyLong("Prompt Backup Remaining", Val(Cbo_days.Text)) Then
MsgBox "Unable To Access Registry - Possible System Error!"
Exit Sub
End If
End If

If Not PutUnisonKeyString("Prompt Backup Date", Date$) Then
MsgBox "Error Accessing Registry!"
Exit Sub
End If

Else
If Not PutUnisonKeyLong("Prompt Backup", 0) Then
MsgBox "Error Accessing Registry!"
Exit Sub
End If

If Not PutUnisonKeyString("Prompt Backup Date", "") Then
MsgBox "Error Accessing Registry!"
Exit Sub
End If
End If

exit_form:

End
End Sub

Private Sub cmd_Load_Click()
Set Drive = Drives(lst_AvailableDevices.ListIndex)
Drive.LoadCD
End Sub

Private Sub Drive_OnDoneErase(OK As Boolean)
DriveFinished = True
End Sub

Private Sub Form_Initialize()
Dim myIndex As Integer
Dim Major_High As Integer
Dim Major_Low As Integer
Dim Minor_High As Integer
Dim Minor_Low As Integer
Dim ValidVersion As Boolean
Dim LastError As Long
Dim promptfile As Integer

On Error GoTo Exit_Me

Set Nero = New Nero


'check version OK
ValidVersion = True
Nero.APIVersion Major_High, Major_Low, Minor_High, Minor_Low
If Major_High < 6 Then
ValidVersion = False
ElseIf Major_High = 6 And Major_Low < 3 Then
ValidVersion = False
ElseIf Major_High = 6 And Major_Low = 3 And Minor_High < 1 Then
ValidVersion = False
ElseIf Major_High = 6 And Major_Low = 3 And Minor_High = 1 And Minor_Low < 6 Then
ValidVersion = False
End If

If Not ValidVersion Then
MsgBox "Nero Version 6.3.1.6 Or Greater Required!"
End
End If

fme_Progress.Visible = False
pgs_Burn.Value = 0

lst_Messages.Clear

Set Drives = Nero.GetDrives(NERO_MEDIA_CD + NERO_MEDIA_DVD_ANY)

For myIndex = 0 To Drives.Count - 1
lst_AvailableDevices.AddItem Drives(myIndex).DeviceName, myIndex
Next

'set to second item as I have 2 CDs for bending machines normally would use first as only 1 or allow to select?
lst_AvailableDevices.ListIndex = Drives.Count - 2

Set Folder = New NeroFolder

Set Drive = Drives(lst_AvailableDevices.ListIndex)
'Drive.EjectCD
Exit Sub

Exit_Me:
MsgBox Error$
End
End Sub

Private Sub cmd_Abort_Click()
Dim Response As Long

Response = MsgBox("Abort May Cause Media To Become Non-Read/Writeable! Abort Anyway?", vbYesNo + vbExclamation)
If Response = vbYes Then
Nero.Abort
CANCELPRESSED = True
AddMessage ""
AddMessage "Abort Pressed!"
End If
End Sub

Private Sub cmd_Burn_Click()
Dim Source_Dir As String
Dim FSO As New FileSystemObject
Dim DateFolder As NeroFolder
Dim I As Integer
Dim X As Long

On Error GoTo Exit_Me:

CANCELPRESSED = False
cmd_Abort.Visible = True
cmd_Burn.Enabled = False
cmd_Exit.Enabled = False

fme_Progress.Visible = True
fme_Messages.Visible = True
lst_Messages.Clear
Me.Refresh

Set Drive = Drives(lst_AvailableDevices.ListIndex)

'set to be whatever folder you need to backup
Source_Dir = "C:\unison\bend"
If opt_YBC.Value Then
Source_Dir = Source_Dir + "\ybc"
End If
If Opt_Log.Value Then
Source_Dir = Source_Dir + "\log"
End If
If Not FSO.FolderExists(Source_Dir) Then
MsgBox "Error - Source Folder Does Not Exist!"
GoTo Exit_Me
End If

Set Folder = New NeroFolder



'check if multisession data
AddMessage "Checking Media For Existing Data"
DriveFinished = False
Drive.CDInfo NERO_READ_ISRC
' wait for event done and handled
While Not DriveFinished
If CANCELPRESSED Then
GoTo Exit_Me
End If
X = DoEvents()
Wend

'if existing session then import the last one
If NumExistingTracks < 0 Then
' no disk ready
GoTo Exit_Me
End If

'if existing session then import the last one
If NumExistingTracks > 0 Then

AddMessage "Reading Existing Data From Media"

'read in the last session
I = NumExistingTracks - 1
DriveFinished = False

Drive.ImportIsoTrack I, NERO_IMPORT_ISO_ONLY

' wait for event done and handled
While Not DriveFinished
If CANCELPRESSED Then
GoTo Exit_Me
End If
X = DoEvents()
Wend

End If

Set DateFolder = New NeroFolder
Set ISOTrack = New NeroISOTrack

If opt_Bend.Value Then
DateFolder.Name = "Bend " + Format(Now, "dd") + "-" + Format(Now, "mm") + "-" + Format(Now, "yyyy") + " - " + Format(Now, "hh") + "-" + Format(Now, "nn") + "-" + Format(Now, "ss")
End If
If opt_YBC.Value Then
DateFolder.Name = "YBC " + Format(Now, "dd") + "-" + Format(Now, "mm") + "-" + Format(Now, "yyyy") + " - " + Format(Now, "hh") + "-" + Format(Now, "nn") + "-" + Format(Now, "ss")
End If
If Opt_Log.Value Then
DateFolder.Name = "Log " + Format(Now, "dd") + "-" + Format(Now, "mm") + "-" + Format(Now, "yyyy") + " - " + Format(Now, "hh") + "-" + Format(Now, "nn") + "-" + Format(Now, "ss")
End If

' Add to folder tree
Folder.Folders.Add DateFolder

' recursively build folder tree
Call BuildFileFolderTree(DateFolder, FSO.GetFolder(Source_Dir))

ISOTrack.Name = "Unison"
ISOTrack.RootFolder = Folder
ISOTrack.BurnOptions = NERO_BURN_OPTION_CREATE_ISO_FS + NERO_BURN_OPTION_USE_JOLIET

If CANCELPRESSED Then
GoTo Exit_Me
End If

' burn folder (check if underrun protection available and use if it is)
DriveFinished = False
If Drive.Capabilities And NERO_CAP_BUF_UNDERRUN_PROT Then
Drive.BurnIsoAudioCD "Unison", "Backup", 0, ISOTrack, Nothing, Nothing, NERO_BURN_FLAG_WRITE + NERO_BURN_FLAG_BUF_UNDERRUN_PROT + NERO_BURN_FLAG_CLOSE_SESSION, 0, NERO_MEDIA_CDR + NERO_MEDIA_CDRW + NERO_MEDIA_DVD_M_R + NERO_MEDIA_DVD_M_RW + NERO_MEDIA_DVD_P_R + NERO_MEDIA_DVD_P_R9 + NERO_MEDIA_DVD_P_RW
Else
Drive.BurnIsoAudioCD "Unison", "Backup", 0, ISOTrack, Nothing, Nothing, NERO_BURN_FLAG_WRITE + NERO_BURN_FLAG_CLOSE_SESSION, 0, NERO_MEDIA_CDR + NERO_MEDIA_CDRW + NERO_MEDIA_DVD_M_R + NERO_MEDIA_DVD_M_RW + NERO_MEDIA_DVD_P_R + NERO_MEDIA_DVD_P_R9 + NERO_MEDIA_DVD_P_RW
End If

While Not DriveFinished
If CANCELPRESSED Then
GoTo Exit_Me
End If
X = DoEvents()
Wend

cmd_Abort.Visible = False
cmd_Burn.Enabled = True
cmd_Exit.Enabled = True
pgs_Burn.Value = 0
fme_Progress.Visible = False
Exit Sub

Exit_Me:

lst_Messages.AddItem Error$
lst_Messages.AddItem Nero.LastError

cmd_Abort.Visible = False
cmd_Burn.Enabled = True
cmd_Exit.Enabled = True
pgs_Burn.Value = 0
fme_Progress.Visible = False

End Sub

Private Sub drive_OnAborted(Abort As Boolean)
Abort = False
End Sub

Private Sub drive_OnAddLogLine(TextType As NEROLib.NERO_TEXT_TYPE, Text As String)
SplitText Text
End Sub

' event for burn complete prints results to message list
Private Sub drive_OnDoneBurn(StatusCode As NEROLib.NERO_BURN_ERROR)

SplitText Nero.ErrorLog
SplitText Nero.LastError

If StatusCode <> NEROLib.NERO_BURN_OK Then
AddMessage "Burn not finished successfully: " & StatusCode
Else
AddMessage "Burn finished successfully"
End If

DriveFinished = True

End Sub

'event for read cd info done
Private Sub Drive_OnDoneCDInfo(ByVal pCDInfo As NEROLib.INeroCDInfo)
'set number of existing sessions
On Local Error GoTo NoTracks:

If pCDInfo Is Nothing Then
MsgBox "No Disk Inserted, Please Insert Disk Then Try Again!"
NumExistingTracks = -1
DriveFinished = True
Exit Sub
End If
NumExistingTracks = pCDInfo.Tracks.Count
'set done flag
DriveFinished = True
Exit Sub

NoTracks:
NumExistingTracks = 0
DriveFinished = True
End Sub

' importing of data done event
Private Sub Drive_OnDoneImport2(ByVal bOk As Boolean, ByVal pFolder As NEROLib.INeroFolder, ByVal pCDStamp As NEROLib.INeroCDStamp, ByVal pImportInfo As NEROLib.INeroImportDataTrackInfo, ByVal importResult As NEROLib.NERO_IMPORT_DATA_TRACK_RESULT)
Dim I As Integer

If bOk Then
Set Folder = pFolder
Else
MsgBox "Error Reading In Data"
End If
' set done flag
DriveFinished = True
End Sub

Private Sub drive_OnDoneWaitForMedia(Success As Boolean)
AddMessage "Done waiting for media."
End Sub

Private Sub drive_OnProgress(ProgressInPercent As Long, Abort As Boolean)
Abort = False
pgs_Burn.Value = ProgressInPercent
End Sub

Private Sub drive_OnSetPhase(Text As String)
SplitText Text
End Sub

Private Sub Form_Load()

Dim result As Long
Dim RemainingResult As Long
Dim loop1 As Integer

For loop1 = 1 To 30
Cbo_days.AddItem Str$(loop1)
Next

result = 0

If Not GetUnisonKeyLong("Prompt Backup", result) Then
MsgBox "Unable To Access Registry - Possible System Error!"
Exit Sub
End If

RemainingResult = 0

If Not GetUnisonKeyLong("Prompt Backup Remaining", RemainingResult) Then
MsgBox "Unable To Access Registry - Possible System Error!"
Exit Sub
End If

If result <> 0 Then
chk_prompt.Value = 1
Cbo_days.Text = Str$(result)
Else
Cbo_days.Text = "30"
Lab_days_remaining.Visible = False
Lab_days_remaining_text.Visible = False
End If

If result <> 0 Then
Lab_days_remaining.Caption = Str$(RemainingResult)
Else
Lab_days_remaining.Caption = ""
End If


lab_version.Caption = App.Major & "." & App.Minor & "." & App.Revision

End Sub

Private Sub nero_OnMegaFatal()
AddMessage "A fatal error has occurred."
End Sub

Private Sub nero_OnNonEmptyCDRW(Response As NEROLib.NERO_RESPONSE)
AddMessage "CD-RW not empty!"
Response = NERO_RETURN_EXIT
End Sub

Private Sub nero_OnRestart()
AddMessage "The system is being restarted."
End Sub

Private Sub nero_OnWaitCD(WaitCD As NEROLib.NERO_WAITCD_TYPE, WaitCDLocalizedText As String)
SplitText WaitCDLocalizedText
End Sub

Private Sub nero_OnWaitCDDone()
AddMessage "Done waiting for Media."
End Sub

Private Sub nero_OnWaitCDMediaInfo(LastDetectedMedia As NEROLib.NERO_MEDIA_TYPE, LastDetectedMediaName As String, RequestedMedia As NEROLib.NERO_MEDIA_TYPE, RequestedMediaName As String)
AddMessage "Waiting for a particular media type: " + RequestedMediaName
End Sub

Private Sub nero_OnWaitCDReminder()
AddMessage "Still waiting for Media..."
End Sub

Public Sub Delay(ByVal Time As Single, Optional ByVal ForceWait As Boolean = False)
Dim Start
Dim X
Dim SleepVal As Long

Start = Timer
While Start + Time > Timer
If Start > Timer Then
Start = Timer
End If
If Not ForceWait Then
X = DoEvents()
End If
Wend
End Sub



'insert this in a module, most of declarations not needed for this but can`t be bothered to sift through;-)

'Global Factor As Integer
'Global Fraction As Integer
'Global Total As Single
'Global Zero As String
'Global Dec_Point As String

Global Const DB_READONLY = 4
Global Const ALARM_NO_TUBE = 11
Global Const BEND_ARM_CHECK = 52
Global Const BEND_COLUMNS = 6
Global Const BEND_ROWS = 50
Global Const BOXES As Integer = 20
Global Const BUFFER_SIZE As Long = 255
Global Const CLUTCH_IN = 15
Global Const CLUTCH_OUT = 16
Global Const COLLET = 4
Global Const COLLET_CLOSE_BUTTON = 54
Global Const COLLET_CLOSE_BUTTON_UNPRESSED = 67
Global Const Collet_Grip = 36
Global Const COLOUR_COUNT = 5
Global Const COORDS As Integer = 6
Global Const DBB_Down = 29
Global Const DBB_INIT = 37
Global Const PDIE_INIT = 73
Global Const CLAMP_INIT = 74
Global Const DBB_PULL = 70
Global Const DBB_PUSH = 69
Global Const DBB_UP = 27
Global Const DK12ADD As Integer = 3 'Dk12 Address Code - 3 = Unison
Global Const DONE = 2
Global Const DRIVE_ENABLED = 3
Global Const DRIVE_OVERLOAD = 50
Global Const EMERGENCY_STOP = 17
Global Const ERROR_NO_MORE_ITEMS As Long = 259&
Global Const ERROR_SUCCESS As Long = 0
Global Const FORMAT_FULL = &H1
Global Const FORMAT_QUICK = 0
Global Const gREGKEYSYSINFO = "SOFTWARE\Microsoft\Shared Tools\MSINFO"
Global Const gREGKEYSYSINFOLOC = "SOFTWARE\Microsoft\Shared Tools Location"
Global Const gREGVALSYSINFO = "PATH"
Global Const gREGVALSYSINFOLOC = "MSINFO"
Global Const GRIPPED = 32
Global Const HARDWARE = 14
Global Const HKEY_LOCAL_MACHINE = &H80000002
Global Const HOPPER_EMPTY = 18
Global Const IDLE = 0
Global Const INFINITE = -1&
Global Const INIT = 1
Global Const ITEMS As Integer = 4
Global Const KEY_ALL_ACCESS = &H2003F 'Reg Key Security Options...
Global Const LOADER_BACK = 9
Global Const LOADER_ES = 44
Global Const LOADER_GRIPPED_2 = 39
Global Const LOADER_INITIALISED = 68
Global Const LOADER_PRESSURE_SWITCH_ES = 56
Global Const LOADER_READY = 40
Global Const LOADER_UNGRIPPED = 33
Global Const LOADER_UNGRIPPED_2 = 38
Global Const MANDREL_BACK = 23
Global Const Mandrel_Down = 28
Global Const MANDREL_FWD = 22
Global Const MANDREL_LUB_EMPTY_ES = 48
Global Const MANDREL_LUB_LOW_ES = 49
Global Const MANDREL_UP = 26
Global Const MAX_STACK = 7
Global Const MF_BYPOSITION = &H400
Global Const MOVING = 7
Global Const NODATA = 3
Global Const NOFINALY = 5
Global Const NORMAL_PRIORITY_CLASS = &H20&
Global Const NUM_ADJUST = 45
Global Const NUM_AXIS = 15
Global Const NUM_CALCS = 7
Global Const NUM_CONFIG = 10
Global Const NUM_CONTROL = 45
Global Const NUM_DIARY = 40
Global Const NUM_FACTORS = 50
Global Const NUM_FOLLOWER = 17
Global Const NUM_GLOBALS = 100
Global Const NUM_OPTIONS = 20
Global Const NUM_MESSAGES = 660
Global Const NUM_MOTORS = 28
Global Const NUM_SEQ = 10
Global Const NUM_SYSTEM = 17
Global Const OFFICE_VERSION As Boolean = False
Global Const TRAINING_VERSION As Boolean = False
Global Const OK = 2
Global Const OVER = 6
Global Const OVERLOAD = 71
Global Const P_LOCKED = 20
Global Const P_UNLOCKED = 21
Global Const PAUSED = 1
Global Const PC_CABINET_ES = 45
Global Const PDIE_Down = 35
Global Const PDIE_UP = 34
Global Const PENDENT_ES = 41
Global Const PI = 3.141592654
Global Const PLATTERN = 12
Global Const POB_DATUM_SWITCH = 57
Global Const PRESSURE_SWITCH_ES = 47
Global Const PROJECT_SPECIFIC1 = 59
Global Const PROJECT_SPECIFIC1_OFF = 63
Global Const PROJECT_SPECIFIC2 = 60
Global Const PROJECT_SPECIFIC2_OFF = 64
Global Const PROJECT_SPECIFIC3 = 61
Global Const PROJECT_SPECIFIC3_OFF = 65
Global Const PROJECT_SPECIFIC4 = 62
Global Const PROJECT_SPECIFIC4_OFF = 66
Global Const READ_CONTROL = &H20000
Global Const RECAPTURE = 6
Global Const REG_DWORD = 4 ' 32-bit number
Global Const REG_OPTION_BACKUP_RESTORE = 4 ' open for backup or restore
Global Const REG_OPTION_NON_VOLATILE = 0 ' Key is preserved when system is rebooted
Global Const REG_OPTION_VOLATILE = 1 ' Key is not preserved when system is rebooted
Global Const REG_SZ = 1
Global Const RELEASE = 1
Global Const ROBOTKEY As String = "Software\Unison\Bender"
Global Const SCREENKEY As String = "Software\Unison\Bender\Screens"
Global Const RUNNING = 2
Global Const SEAM_NOT_FOUND = 55
Global Const SHFMT_CANCEL = &HFFFFFFFE
Global Const SHFMT_ERROR = &HFFFFFFFF
Global Const SHFMT_NOFORMAT = &HFFFFFFFD
Global Const SIZE_ADJUST = 45
Global Const SIZE_AXIS = 25
Global Const SIZE_CALCS = 50
Global Const SIZE_CONFIG = 50
Global Const SIZE_CONTROL = 50
Global Const SIZE_DIARY = 50
Global Const SIZE_FACTORS = 50
Global Const SIZE_FOLLOWER = 40
Global Const SIZE_GLOBALS = 200
Global Const SIZE_INPUTS_OUTPUT = 40
Global Const SIZE_MACHINE = 100
Global Const SIZE_MESSAGES = 1000
Global Const SIZE_MOTOR = 40
Global Const SIZE_OTHER = 200
Global Const SIZE_SEQ = 40
Global Const SIZE_SYSTEM = 40
Global Const SIZE_UNLOADER = 20
Global Const SMAT_ES = 46
Global Const SOFTWARE = 24
Global Const SPLATE_INSIDE_ES = 42
Global Const SPLATE_OUTSIDE_ES = 43
Global Const SRCCOPY As Long = &HCC0020
Global Const STANDARD_RIGHTS_ALL = &H1F0000
Global Const STANDARD_RIGHTS_EXECUTE = (READ_CONTROL)
Global Const STANDARD_RIGHTS_READ = (READ_CONTROL)
Global Const STANDARD_RIGHTS_REQUIRED = &HF0000
Global Const STANDARD_RIGHTS_WRITE = (READ_CONTROL)
Global Const SW_HIDE = 0
Global Const SW_SHOW = 5
Global Const SW_SHOWNORMAL = 1
Global Const THS = 5
Global Const TOOLING_CLEAR = 4
Global Const TOOLING_LOCK = 30
Global Const TOOLING_UNLOCK = 31
Global Const TOTAL_DATA As Integer = 9
Global Const TUBE_IN_COLLET_SWITCH = 53
Global Const TUBE_NOT_ON_C_L = 19
Global Const TUBE_ON_C_L = 8
Global Const UNLOADER_CLEAR = 51
Global Const UNLOADER_FULL = 58
Global Const UNLOADER_GRIPPED = 10
Global Const UNLOADER_UNGRIPPED = 13
Global Const XYZ_COLUMNS = 3
Global Const ZERO_SPEED = 25
Global Const SPI_SETSCREENSAVEACTIVE = 17

Global AD_SELECTED As Integer
Global AVERAGE_TIME_TIMES As Long
Global AVERAGE_TIME_TOTAL As Single
Global B_SELECTED As Integer
Global BATCH_QUANTITY As Double
Global BF_SELECTED As Integer
Global BS_SELECTED As Integer
Global B_JOG_SELECTED As Integer
Global C_PRODUCT_LENGTH As Single
Global C_SELECTED As Integer
Global CS_SELECTED As Integer
Global CANCELPRESS As Boolean
Global CANCELPRESSED As Boolean
Global CD_SELECTED As Integer
Global CLAMP_CLOSE_FULLY As Integer
Global CLAMP_OPEN_DISTANCE As Integer
Global CLAMP_STROKE As Single
Global CONNECTED As Boolean
Global COS_SELECTED As Integer
Global count_Down As Integer
Global Count_Up As Integer
Global CT_SELECTED As Integer
Global CURRENT_DIRECTORY As String
Global DIAM_SELECTED As Integer
Global ELONGATION_POSITION As Integer
Global ELONGATION_FACTOR As Double
Global END_FLOOR_TIME As Single
Global END_TIME As Single
Global FILENAME As String
Global ITPCOMM As Integer
Global ITPBAUD As Long
Global ITPBITS As Integer
Global ITPSTOP As Integer
Global ITPPARITY As String
Global LASTHANDLE As Integer
Global LOGFILE As Integer
Global Long_Move_To_Do As Long
Global MA_SELECTED As Integer
Global MACHINE_STATUS As Integer
Global Move_To_Do As Integer
Global MP_SELECTED As Integer
Global OFFICE_DIRECTORY As String
Global OPENED_FILENAMES(3) As String
Global OPENED_FILENAMES_TEACH(3) As String
Global QUANTITY_ALREADY_DONE As Long
Global QUANTITY_OF_FILE As String
Global POB_MOVE_TO_DO As Integer
Global PORT_NO_DRIVES As Integer
Global POS_SELECTED As Integer
Global PRODUCT_LENGTH As Single
Global PT_SELECTED As Integer
Global Q_R_SELECTED As Integer
Global Q_SELECTED As Integer
Global R_SELECTED As Integer
Global RAD_SELECTED As Integer
Global RD_SELECTED As Integer
Global RELEASE_DISTANCE As Integer
Global RUNNINGINIDE As Boolean
Global SB_SELECTED As Integer
Global SEQ_FILENAME As String
Global SEQUENTIAL_IGNORE_SETUP As Integer
Global SEQUENTIAL_PRODUCTION As Integer
Global ST_SELECTED As Integer
Global Start_Bend As Integer
Global START_FLOOR_TIME As Single
Global START_TIME As Single
Global Status As Integer
Global TORESIZE As Object
Global TQ_SELECTED As Integer
Global TRAV_SELECTED As Integer
Global TU_SELECTED As Integer
Global TUBE_RELEASED As Integer
Global Y_SELECTED As Integer
Global YS_SELECTED As Integer
Global Y_JOG_SELECTED As Integer
Global CODB_SELECTED As Integer
Global PODB_SELECTED As Integer
Global FILEEXIST

Global Const SPI_SETDESKWALLPAPER = 20
Global Const SPIF_UPDATEINIFILE = &H1

Global Clamp_Close As Integer
Global PDie_Stroke As Single
Global PDie_Open_Distance As Integer
Global PDie_Close_Fully As Integer
Global Pdie_Close As Integer
Global Mandrel_Stroke As Single
Global Machine_Initialised As Integer
Global Machine_Setup As Integer
Global Initialising As Integer
Global Setting_Up As Integer
Global Sequencing As Integer
Global DBB_Offset As Single
Global Tooling_Clearance As Integer
Global YCurrent_Position As Single
Global exit_setup As Integer
Global First_Part As Integer
Global First_Sequential_Part As Integer


Global Comms_Exit As Integer
Global Comms_Finished As Integer

Global Auto_Loading As Boolean
Global Auto_Unloading As Boolean
Global Pre_Load As Boolean
Global Move_To_Pickup As Boolean
Global Gripped_At_Pickup As Boolean
Global Stop_Pressed As Integer
Global diagnostics_on As Integer
Global Caution_Required As Boolean


Global Axis_Exist(SIZE_AXIS) As Integer
Global Axis_Selected(SIZE_AXIS) As Boolean
Global Axis_Scale(SIZE_AXIS) As Single
Global Axis_Torque(SIZE_AXIS) As Single
Global Axis_Speed(SIZE_AXIS) As Single
Global Axis_Stroke(SIZE_AXIS) As Single
Global Axis_Other(SIZE_OTHER) As Single
Global Axis_Current_Position(SIZE_AXIS) As Single

Global Axis_Zero_Position(SIZE_AXIS) As Single
Global Axis_Direction(SIZE_AXIS) As Integer
Global Axis_Inputs(SIZE_INPUTS_OUTPUT) As Integer
Global Axis_Outputs(SIZE_INPUTS_OUTPUT) As Integer
Global Axis_Target(SIZE_AXIS) As Single

Global Loader_Array(100) As Single

Global Overall_Speed As Integer
Global Datum_Position As Single
Global Load_Position As Single

Global DBB_Traverse_Datum_Position As Single
Global Mandrel_Traverse_Datum_Position As Single
Global YBC_Data(BEND_ROWS, BEND_COLUMNS) As Double
Global XYZ_Data(BEND_ROWS, XYZ_COLUMNS) As Double

Global ISO_Data(BEND_ROWS, XYZ_COLUMNS) As Double
Global load_XYZ As Integer

Global Radius(BEND_ROWS) As Double
Global Adjustment(BEND_ROWS, XYZ_COLUMNS) As Double
Global Stack_Number(BEND_ROWS) As Integer
Global bend_option(BEND_ROWS) As Integer
Global Current_Stack_Number As Integer
Global Springback_Offset(BEND_ROWS) As Single
Global Roll_Form_Radius(BEND_ROWS) As Single
Global DBB_Absolute_Moves(BEND_ROWS) As Integer
Global Follower_Percentage(BEND_ROWS) As Single
Global Mandrel_Forward_Position(BEND_ROWS) As Single
Global Clamp_Torque_Percentage(BEND_ROWS) As Single
Global Pdie_Torque_Percentage(BEND_ROWS) As Single
Global Clamp_Offset_Amount(BEND_ROWS) As Single
Global Pdie_Offset_Amount(BEND_ROWS) As Single
Global Stack_Traverse_Amount(BEND_ROWS) As Single
Global Clamp_Open_During_Bend(BEND_ROWS) As Single
Global Pdie_Open_During_Bend(BEND_ROWS) As Single

'Data Relating To Machine eg. P.Die Length

Global Diary_Data(SIZE_DIARY) As Single

Global Control_Data(SIZE_CONTROL) As Single

Global Follower(SIZE_FOLLOWER) As Single

Global Follower_Profile(SIZE_FOLLOWER) As Single

Global System_Data(SIZE_SYSTEM) As Single

Global Calcs_Data(SIZE_CALCS) As Single

Global Motor_Data(SIZE_MOTOR) As Single

Global Elongation_Factors(SIZE_FACTORS) As String

Global Config_Data(SIZE_CONFIG) As String

Global Unloader_Data(SIZE_UNLOADER) As Single

Global Seq_Names(SIZE_SEQ) As String

Global Seq_Quantity(SIZE_SEQ) As Long

'Global AB_Globals(SIZE_GLOBALS) As Single

Global Messages(SIZE_MESSAGES) As String

'Global History(SIZE_HISTORY) As String

Global Stack_Clamp_Torques(MAX_STACK) As Single
Global Stack_Pdie_Torques(MAX_STACK) As Single
Global Stack_Radius(MAX_STACK) As Single
Global Stack_Clamp_Length(MAX_STACK) As Single
Global Stack_Pdie_Length(MAX_STACK) As Single
Global Stack_Wiper_Length(MAX_STACK) As Single
Global Stack_mandrel_Pos(MAX_STACK) As Single
Global Stack_Tooling_Move(MAX_STACK) As Single
Global Stack_Clamp_Move(MAX_STACK) As Single
Global Stack_Clamp_Depth(MAX_STACK) As Single
Global Stack_PDie_Depth(MAX_STACK) As Single
Global Stack_Pitch(MAX_STACK) As Single
Global Stack_Absolute_Position(MAX_STACK) As Single
Global Stack_DBB_Forward(MAX_STACK) As Single
Global Stack_DBB_Speed(MAX_STACK) As Single
Global Stack_Traverse_Move(MAX_STACK) As Single
Global Stack_Traverse_Speed(MAX_STACK) As Single
Global Stack_Change_Position(MAX_STACK) As Single


Global FileChanged As Integer
Global NewData As Integer

Global Fail1_Count(SIZE_AXIS) As Integer
Global Fail2_Count(SIZE_AXIS) As Integer
Global Fail3_Count(SIZE_AXIS) As Integer



Global try As Long
Global failure As Long
Global Main_Password As String
Global Entered_Password As Integer
Global password_accepted As Integer
Global password_string As String
Global admin_password As String
Global User_Logged_On_Password As String

Global Maintenence_Completed As Integer
Global Const Parts_Between_Maintenence = 20000
Global Maintenence_Entered As Integer


Global days_remaining As Single
Global machine_positions As Integer

Global Stored_Bend_Angle As Long
Global Stored_Calc_Angle As Long
Global DOB_Forward As Boolean
Global Old_Log_Value As Integer
Global diagnostic_status As String
Global Bender_Project As String
Global Metric_Factor As Single
Global diagnostics_not_exit As Integer
Global Machine_Exit As Integer
Global Extra_DBB_Done As Boolean
Global Log_Ring_Rolling As Boolean

Global teach_sequence(500, 2) As Single
Global teach_insert(500, 2) As Single
Global temp_array(500, 2) As Single
Global teach_no As Integer
Global insert_no As Integer
Global insert_teach As Integer
Global insert_teach_line As Integer
Global main_teach_no As Integer
Global store_main_sequence As Integer
Global store_main_sequence_selected As Integer
Global teach_radius As Single
Global teach_speed As Integer
Global Previous_Speed_Teach(SIZE_AXIS) As Single

Global manual_radius As Single

Global fail_number As Integer
Global exit_number As Integer

Global Drive_Warning As Boolean

Global Clear_position As Single
Global Current_Move As Single
Global current_language As Integer

Global loaded_manual As String
Global loaded_maintenance As String


Global log_array(950) As Single
Global master_array(950) As Single
Global last_array(950) As Single
Global difference_array(950) As Single
Global compare_array(950) As Single
Global max_bend As Single
Global Max_torque As Single
Global chart As String
Global Master_Displayed As Boolean
Global difference_displayed As Boolean
Global Last_Displayed As Boolean
Global compare_Displayed As Boolean
Global last_differance As String

Global graph_screen_displayed As Integer

Global Const Num_Admin = 39
Global admin_option(Num_Admin) As Boolean

Global copy_variable As Single

Global LoginSucceeded As Boolean
Global Login_Names(20, 3) As String
Global Logged_On As Integer
Global User_Logged_On As String

Global Stored_Status_Message As String
Global Stored_Dbb_Traverse_On_Load As Single
Global load_ok As Boolean

Global Button_Press(200) As String

Global num_parts_completed As Single
Global Part_Counter_Found As Boolean
Global Part_Database_Found As Boolean
Global Machine_Info_Database_Found As Boolean

Global material_array(950) As Single


Global WINDIR As String
Global SYSDIR As String



Global Loading_Pickup_Position As Single

Global popup_on As Boolean

Global turn_parameters_on As Boolean

Global bend_arm_check_pre_release_position As Single

Global Release_Required As Integer
Global Collet_Gripped As Integer
Global Recaptured As Boolean
Global Recapture_Distance As Long
Global Dbb_In_Load_Area As Boolean
'Dim start_time As Long
'Dim end_time As Long
'MTG 19-05-03
Global start_auto_loading_no_unloading_timer As Single
Global end_auto_loading_no_unloading_timer As Single
Global Last_Bend_No As Integer
Global Current_Bend_No As Integer
Global Number_Of_Stacks_Used As Integer


Global Change_Stack As Boolean
Global Split_Tooling As Boolean

Global Previous_Speed_DBB As Integer
Global Previous_Speed_POB As Integer
Global Previous_Speed_DOB As Integer
Global Previous_Speed_DBB_Trav As Integer

Global Dummy_Move_Done As Boolean
Global Pressure_Die_Opened As Boolean

Global Largest_Traverse_Position As Single
Global Largest_Stack_To_Traverse As Single
Global Smallest_Stack_To_Traverse As Single

Global procedure_id As Integer

Global switch_description_displayed As Boolean

Global Clamp_Distance As Integer
Global Pdie_Distance As Integer
Global Mandrel_Movement As Long


Global Roll_Form_Material_Database As String
Global Roll_Form_Material_Selected As String
Global Roll_Form_Blend_Distance As Integer


Global Sequential_Total_Quantity As Integer
Global Sequential_Stopped As Boolean

Global Abort_Code As Single
Global Startup_Abort As Integer

Global Traverse_Done As Boolean

Global Maintenence_Due As Boolean

Global Traverse_Long_Bed As Boolean
Global DBB_Up_Long_Bed As Boolean

Global Sequence_List_Count As Integer

Global Carriage_Push_Move_To_Do As Long
Global DOB_Speed_Rate As Single

Global Switch_Cleared As Boolean
Global Switch_Not_Cleared As Boolean

Global Const Sequence_Diagnostics_Allowed = True
Global POB_Rotate_Done As Boolean

Global Changed_Directory As String
Global Changed_Drive As String

Global THS_Offline_Pressed As Boolean

Global PCANYWHEREPATH As String
Global AWHOSTPATH As String
Global MODEMBHFPATH As String
Global UNIBENDOFFICEPATH As String
Global DIRECTCDPATH As String

Global Pdie_Digital_Locking_Broken As Boolean

Global Copy_Value As Single
Global Machine_Position_Selected As Integer

Global Actual_Stack_Number As Integer

Global Machine_Analysis_On As Boolean
Global Testing_Axis As Boolean

Global Number_Stacks_Used As Integer


Global NumITPLines
Global Option_Required As Integer

Global Test_Time_St As Single
Global Unload_Time_St As Single

Global Stopped_Message As String

Global Password_Displayed As Boolean

Global Test_Springback As Boolean

Global Stop_Test As Boolean

Global Print_Preview As Boolean

Global Total_Parts As Integer
Global Part_Average_Cycle_Time As Single
Global Parts_Completed_In_Hour As Integer
Global Current_Hour As Integer

'MTG 19-05-03
Global Autoload_Move_Done As Boolean

Global Waiting_Dialog As Boolean

Global Setting_Clamp_Depth As Boolean
Global Setting_Pdie_Depth As Boolean

Global Max_Dob_Bend_Speed As Single

Global Prompt_Backup_Days_Left As Integer
Global Prompt_Backup_Date As String

Global Jog_Action_Allowed As Boolean

Global Input_Output_States_On As Boolean
Global Input_Output_Screen_On As Boolean

Global Input_String As String
Global Input_Cancel As Boolean
Global Input_Integer As Boolean

Global Save_Visible As Boolean
Global Save_Cancel_Pressed As Boolean

Global Const keypad_keys_colour = 15977622
Global Const keypad_background_colour = 11170625
Global Const calc_keys_colour = 11388076
Global Const calc_keys_colour2 = 11189899
Global Const Enabled_Colour = 2276161

Global Notes_On_Load As Boolean

Global Machine_Speed As Integer

Global Overall_Dwell As Boolean

Global Machine_Stopped As Boolean

Global Machine_ID As String

Global Camera_Location As String

Global Sequence_File_Created As Boolean


Private Type STARTUPINFO
cb As Long
lpReserved As String
lpDesktop As String
lpTitle As String
dwX As Long
dwY As Long
dwXSize As Long
dwYSize As Long
dwXCountChars As Long
dwYCountChars As Long
dwFillAttribute As Long
dwFlags As Long
wShowWindow As Integer
cbReserved2 As Integer
lpReserved2 As Long
hStdInput As Long
hStdOutput As Long
hStdError As Long
End Type

Private Type PROCESS_INFORMATION
hProcess As Long
hThread As Long
dwProcessID As Long
dwThreadID As Long
End Type

Public Type LUID
UsedPart As Long
IgnoredForNowHigh32BitPart As Long
End Type

Public Type TOKEN_PRIVILEGES
PrivilegeCount As Long
TheLuid As LUID
Attributes As Long
End Type


Public Declare Function SearchTreeForFile Lib "imagehlp.dll" (ByVal LpRootPath As String, ByVal LpInputPathName As String, ByVal lpOutputPathBuffer As String) As Long
Public Declare Function SetTextColor Lib "GDI32" (ByVal hDC As Long, ByVal crColor As Long) As Long
Public Declare Function RemoveMenu% Lib "user32" (ByVal hMenu%, ByVal nPosition%, ByVal wFlags%)
Public Declare Function GetSystemMenu% Lib "user32" (ByVal hwnd%, ByVal revert%)
Public Declare Function TextOut Lib "GDI32" Alias "TextOutA" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long, ByVal lpString As String, ByVal nCount As Long) As Long
Public Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpbuffer As String, ByVal nSize As Long) As Long
Public Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpbuffer As String, ByVal nSize As Long) As Long
Public Declare Function FindExecutable Lib "shell32.dll" Alias "FindExecutableA" (ByVal lpFile As String, ByVal lpDirectory As String, ByVal lpResult As String) As Long
Public Declare Function SHFormatDrive Lib "shell32" (ByVal hwnd As Long, ByVal Drive As Long, ByVal fmtID As Long, ByVal OPTIONS As Long) As Long
Public Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
Public Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function FindDK12% Lib "DK12WN32.DLL" (ByVal Add%)
Public Declare Function DK12DriverInstalled% Lib "DK12WN32.DLL" ()
Public Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long
Public Declare Function FindWindowHandle Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal Handle As String) As Long
Public Declare Function FreeLibrary Lib "kernel32" (ByVal HandleLoc As Long) As Long
Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Public Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal LFILENAME As String) As Long
Public Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Public Declare Function IsWindowVisible Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function BitBlt Lib "GDI32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal XSrc As Long, ByVal YSrc As Long, ByVal dwRop As Long) As Long
Public Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, ByRef phkResult As Long) As Long
Public Declare Function RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, ByRef lpType As Long, ByVal lpData As String, ByRef lpcbData As Long) As Long
Public Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long
Public Declare Function BringWindowToTop Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public Declare Function GetModuleUsage% Lib "Kernel" (ByVal hModule%)
Public Declare Function GetForegroundWindow Lib "user32" () As Long
Public Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, ByVal lpvParam As Any, ByVal fuWinIni As Long) As Long
Public Declare Function GetCurrentProcess Lib "kernel32" () As Long
Public Declare Function OpenProcessToken Lib "advapi32" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long
Public Declare Function LookupPrivilegeValue Lib "advapi32" Alias "LookupPrivilegeValueA" (ByVal lpSystemName As String, ByVal lpName As String, lpLuid As LUID) As Long
Public Declare Function AdjustTokenPrivileges Lib "advapi32" (ByVal TokenHandle As Long, ByVal DisableAllPrivileges As Long, newState As TOKEN_PRIVILEGES, ByVal BufferLength As Long, PreviousState As TOKEN_PRIVILEGES, ReturnLength As Long) As Long
Public Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Public Declare Function CreateProcessA Lib "kernel32" (ByVal lpApplicationName As Long, ByVal lpCommandLine As String, ByVal lpProcessAttributes As Long, ByVal lpThreadAttributes As Long, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As Long, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long
Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Public Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long ' Note that if you declare the lpData parameter as String, you must pass it By Value.
Public Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias "RegCreateKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal Reserved As Long, ByVal lpClass As String, ByVal dwOptions As Long, ByVal samDesired As Long, lpSecurityAttributes As Long, phkResult As Long, lpdwDisposition As Long) As Long
Public Declare Function RegEnumKeyEx Lib "advapi32.dll" Alias "RegEnumKeyExA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, lpcbName As Long, ByVal lpReserved As Long, ByVal lpClass As String, lpcbClass As Long, lpftLastWriteTime As Long) As Long
Public Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
Public Declare Function GetLastError Lib "kernel32" () As Long

Public Function GetUnisonKeyLong(ByVal SubKeyName As String, ByRef result As Long, Optional ByVal DefaultValue As Long = 0) As Boolean
Dim hKey As Long
Dim Size As Long
Dim Res As String
Dim Res2 As String
Dim I As Integer

'checks value exists, if it does returns value in result if not creates new value set to default
GetUnisonKeyLong = False

On Local Error Resume Next

If Not CheckRegistryKey Then
MsgBox "Error Accessing Registry"
Exit Function
End If

If Not RegOpenKeyEx(HKEY_LOCAL_MACHINE, ROBOTKEY, 0, KEY_ALL_ACCESS, hKey) = ERROR_SUCCESS Then
MsgBox "Error Opening Registry Key!"
Exit Function
End If

Size = BUFFER_SIZE

If Not RegQueryValueEx(hKey, SubKeyName, 0, REG_DWORD, vbNull, Size) = ERROR_SUCCESS Then
' doesn`t exist
' create new key
' if string then = len (string ) (may need to add + vbnullstring)

If Not RegSetValueEx(hKey, SubKeyName, 0, REG_DWORD, CInt(DefaultValue), 4&) = ERROR_SUCCESS Then
If Not RegCloseKey(hKey) = ERROR_SUCCESS Then
MsgBox "Error Closing Registry Key!"
Exit Function
End If
MsgBox "Error Writing Registry Key!"
Exit Function
End If
Else

Res = String(Size, Chr(0))

If Not RegQueryValueEx(hKey, SubKeyName, 0, REG_DWORD, Res, Size) = ERROR_SUCCESS Then
If Not RegCloseKey(hKey) = ERROR_SUCCESS Then
MsgBox "Error Closing Registry Key!"
Exit Function
End If
MsgBox "Error Reading Registry Key!"
Exit Function
End If

If (Asc(Right$(Res, 1)) = 0) Then ' Win95 Adds Null Terminated String...
Res = Left$(Res, Size - 1) ' Null Found, Extract From String
Size = Size - 1
End If

Res2 = ""
For I = Size To 1 Step -1 ' Convert Each Bit
Res2 = Res2 + Hex(Asc(Mid(Res, I, 1))) ' Build Value Char. By Char.
Next
result = Val(Format$("&h" + Res2)) ' convert hex string to decimal

End If

If Not RegCloseKey(hKey) = ERROR_SUCCESS Then
MsgBox "Error Closing Registry Key!"
Exit Function
End If
'
GetUnisonKeyLong = True

End Function
Public Function GetUnisonKeyString(ByVal SubKeyName As String, ByRef result As String, Optional ByVal DefaultValue As String = vbNullString) As Boolean
Dim hKey As Long
Dim Size As Long
Dim Res As String
Dim I As Integer

'checks value exists, if it does returns value in result if not creates new value set to default
GetUnisonKeyString = False

On Local Error Resume Next


If Not CheckRegistryKey("REG_SZ") Then
MsgBox "Error Accessing Registry"
Exit Function
End If

If Not RegOpenKeyEx(ByVal HKEY_LOCAL_MACHINE, ByVal ROBOTKEY, ByVal 0, ByVal KEY_ALL_ACCESS, hKey) = ERROR_SUCCESS Then
MsgBox "Error Opening Registry Key!"
Exit Function
End If

Size = BUFFER_SIZE
Res = String(Size, Chr(0))

If Not RegQueryValueEx(ByVal hKey, ByVal SubKeyName, ByVal 0, REG_SZ, Res, Size) = ERROR_SUCCESS Then
' doesn`t exist
' create new key
' if string then = len (string ) (may need to add + vbnullstring)

If Not RegSetValueEx(ByVal hKey, ByVal SubKeyName, ByVal 0, REG_SZ, ByVal DefaultValue, Len(DefaultValue)) = ERROR_SUCCESS Then
If Not RegCloseKey(ByVal hKey) = ERROR_SUCCESS Then
MsgBox "Error Closing Registry Key!"
Exit Function
End If
MsgBox "Error Creating Registry Key!"
Exit Function
End If
result = DefaultValue
Else

If (Asc(Right$(Res, 1)) = 0) Then ' Win95 Adds Null Terminated String...
Res = Left$(Res, Size - 1) ' Null Found, Extract From String
Size = Size - 1
End If
result = Res

End If

If Not RegCloseKey(ByVal hKey) = ERROR_SUCCESS Then
MsgBox "Error Closing Registry Key!"
Exit Function
End If

GetUnisonKeyString = True

End Function
Public Function PutUnisonKeyString(ByVal SubKeyName As String, ByVal Value As String) As Boolean
Dim hKey As Long
Dim Size As Long

'checks value exists, if it does returns value in result if not creates new value set to default
PutUnisonKeyString = False

On Local Error Resume Next

If Not CheckRegistryKey("REG_SZ") Then
MsgBox "Error Accessing Registry"
Exit Function
End If

If Not RegOpenKeyEx(ByVal HKEY_LOCAL_MACHINE, ByVal ROBOTKEY, ByVal 0, ByVal KEY_ALL_ACCESS, hKey) = ERROR_SUCCESS Then
MsgBox "Error Opening Registry Key!"
Exit Function
End If

If Value = "" Then Value = " "
If Not RegSetValueEx(ByVal hKey, ByVal SubKeyName, ByVal 0, REG_SZ, ByVal Value, Len(Value)) = ERROR_SUCCESS Then
If Not RegCloseKey(ByVal hKey) = ERROR_SUCCESS Then
MsgBox "Error Closing Registry Key!"
Exit Function
Else
MsgBox "Error Writing Registry Key!"
Exit Function
End If
End If

If Not RegCloseKey(ByVal hKey) = ERROR_SUCCESS Then
MsgBox "Error Closing Registry Key!"
Exit Function
End If

PutUnisonKeyString = True

End Function


Public Function PutUnisonKeyLong(ByVal SubKeyName As String, ByVal Value As Long) As Boolean
Dim hKey As Long
Dim Size As Long

'checks value exists, if it does returns value in result if not creates new value set to default
PutUnisonKeyLong = False

On Local Error Resume Next

If Not CheckRegistryKey Then
MsgBox "Error Accessing Registry"
Exit Function
End If

If Not RegOpenKeyEx(HKEY_LOCAL_MACHINE, ROBOTKEY, 0, KEY_ALL_ACCESS, hKey) = ERROR_SUCCESS Then
MsgBox "Error Opening Registry Key!"
Exit Function
End If

If Not RegSetValueEx(hKey, SubKeyName, 0, REG_DWORD, CInt(Value), 4&) = ERROR_SUCCESS Then
If Not RegCloseKey(hKey) = ERROR_SUCCESS Then
MsgBox "Error Writing Registry Key!"
Exit Function
Else
MsgBox "Error Closing Registry Key!"
Exit Function
End If
End If

If Not RegCloseKey(hKey) = ERROR_SUCCESS Then
MsgBox "Error Closing Registry Key!"
Exit Function
End If

PutUnisonKeyLong = True

End Function

Public Function CheckRegistryKey(Optional ByVal RegType As String = "REG_DWORD") As Boolean
Dim Handle As Long
Dim Ret As Long
Dim result As Long

CheckRegistryKey = False

If RegOpenKeyEx(ByVal HKEY_LOCAL_MACHINE, ByVal ROBOTKEY, ByVal 0, ByVal KEY_ALL_ACCESS, Handle) = ERROR_SUCCESS Then

Ret = RegCloseKey(ByVal Handle)
' then key must exist
CheckRegistryKey = True
Exit Function

End If

' keydoesn`t exist

' make sure closed
Ret = RegCloseKey(ByVal Handle)

' create new key
result = RegCreateKeyEx(ByVal HKEY_LOCAL_MACHINE, ByVal ROBOTKEY, ByVal 0, ByVal RegType, ByVal REG_OPTION_NON_VOLATILE, ByVal KEY_ALL_ACCESS, ByVal 0&, Handle, Ret)
If result <> ERROR_SUCCESS Then
Exit Function
End If
CheckRegistryKey = True

End Function