From: erg Date: Thu, 20 Jan 2005 19:57:36 +0000 (+0000) Subject: Add build files and extra source files for windows X-Git-Tag: LAST_LIBGRAPH~32^2~8051 X-Git-Url: https://granicus.if.org/sourcecode?a=commitdiff_plain;h=f28e03c138b9a57ea17e048c202dea6975701f2f;p=graphviz Add build files and extra source files for windows --- diff --git a/windows/cmd/gvui/Other.bas b/windows/cmd/gvui/Other.bas new file mode 100644 index 000000000..cd43ff7f9 --- /dev/null +++ b/windows/cmd/gvui/Other.bas @@ -0,0 +1,184 @@ +Attribute VB_Name = "Other" +' +' BrowseForFolder comes from codeguru +' GetExecutable comes from VBWorld +' TrimAll comes from freevbcode + +' +' Suport for the browse directory dialog +' +Public Enum eBIF + BIF_RETURNONLYFSDIRS = &H1 + BIF_DONTGOBELOWDOMAIN = &H2 + BIF_STATUSTEXT = &H4 + BIF_RETURNFSANCESTORS = &H8 + BIF_BROWSEFORCOMPUTER = &H1000 + BIF_BROWSEFORPRINTER = &H2000 +End Enum + +Private Type BROWSEINFO + hwndOwner As Long + pidlRoot As Long + pszDisplayName As String + lpszTitle As String + ulFlags As Long + lpfnCallback As Long + lParam As Long + iImage As Long +End Type + +Private Declare Function SHBrowseForFolder Lib "shell32.dll" (lpbi As BROWSEINFO) As Long +Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long +Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long) + +' +' Support for the find executable +' + +Private Declare Function FindExecutable Lib "shell32.dll" Alias "FindExecutableA" _ + (ByVal lpFile As String, ByVal lpDirectory _ + As String, ByVal lpResult As String) As Long + +Private Declare Function GetTempFileName Lib "kernel32" Alias "GetTempFileNameA" (ByVal _ + lpszPath As String, ByVal lpPrefixString _ + As String, ByVal wUnique As Long, ByVal _ + lpTempFileName As String) As Long + +Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal _ + nBufferLength As Long, ByVal lpBuffer As _ + String) As Long + +' +' high level interfaces +' + +Public Function BrowseForFolder(ByVal hwndOwner As Long, _ + ByVal sPrompt As String, _ + Optional ByVal lFlags As eBIF = BIF_RETURNONLYFSDIRS) As String + ' + Dim iNull As Integer + Dim lpIDList As Long + Dim lResult As Long + Dim sPath As String + Dim udtBI As BROWSEINFO + + With udtBI + .hwndOwner = hwndOwner + .lpszTitle = sPrompt & "" + .ulFlags = BIF_RETURNONLYFSDIRS + End With + + lpIDList = SHBrowseForFolder(udtBI) + If lpIDList Then + sPath = String$(260, 0) + lResult = SHGetPathFromIDList(lpIDList, sPath) + Call CoTaskMemFree(lpIDList) + iNull = InStr(sPath, vbNullChar) + If iNull Then + sPath = Left$(sPath, iNull - 1) + End If + Else + 'Cancel is clicked + sPath = "" + End If + + BrowseForFolder = sPath +End Function + + +Public Function GetExecutable(ByVal Extension As String) As String + + Dim Path As String + Dim FileName As String + Dim nRet As Long + Const MAX_PATH As Long = 260 + + 'Create a tempfile + Path = String$(MAX_PATH, 0) + + If GetTempPath(MAX_PATH, Path) Then + FileName = String$(MAX_PATH, 0) + + If GetTempFileName(Path, "~", 0, FileName) Then + FileName = Left$(FileName, _ + InStr(FileName, vbNullChar) - 1) + + 'Rename it to use supplied extension + Name FileName As Left$(FileName, _ + InStr(FileName, ".")) & Extension + FileName = Left$(FileName, _ + InStr(FileName, ".")) & Extension + + 'Get name of associated EXE + Path = String$(MAX_PATH, 0) + + Call FindExecutable(FileName, vbNullString, Path) + GetExecutable = Left$(Path, InStr(Path, vbNullChar) - 1) + + 'Clean up + Kill FileName + End If + End If + +End Function + +Public Function GetFileExtension(ByVal FilePath As String) As String + Dim Pos As Integer + Pos = InStrRev(FilePath, "\") + If Pos <> 0 Then + FilePath = Right$(FilePath, Len(FilePath) - Pos) + End If + Pos = InStrRev(FilePath, ".") + If Pos <> 0 Then + GetFileExtension = Right$(FilePath, Len(FilePath) - Pos) + Else + GetFileExtension = "" + End If +End Function + +Public Function GetFileName(ByVal FilePath As String) As String + Dim Pos As Integer + Dim apos As Integer + + Pos = InStrRev(FilePath, "\") + apos = InStrRev(FilePath, ".") + + GetFileName = Mid(FilePath, _ + IIf(Pos = 0, 1, Pos + 1), _ + IIf(apos = 0, Len(FilePath), apos - Pos - 1)) +End Function + +Public Function TrimAll(ByVal TextIN As String, Optional NonPrints As Boolean) As String + + TrimAll = Trim(TextIN) + + If NonPrints Then + Dim x As Long + ' remove all non-printable characters + While InStr(TrimAll, vbCrLf) > 0 + TrimAll = Replace(TrimAll, vbCrLf, " ") + Wend + + While InStr(TrimAll, vbTab) > 0 + TrimAll = Replace(TrimAll, vbTab, " ") + Wend + + For x = 0 To 31 + While InStr(TrimAll, Chr(x)) > 0 + TrimAll = Replace(TrimAll, Chr(x), " ") + Wend + Next x + + For x = 127 To 255 + While InStr(TrimAll, Chr(x)) > 0 + TrimAll = Replace(TrimAll, Chr(x), " ") + Wend + Next x + End If + + While InStr(TrimAll, String(2, " ")) > 0 + TrimAll = Replace(TrimAll, String(2, " "), " ") + Wend + +End Function + diff --git a/windows/cmd/gvui/Process.bas b/windows/cmd/gvui/Process.bas new file mode 100644 index 000000000..ec9cf8f13 --- /dev/null +++ b/windows/cmd/gvui/Process.bas @@ -0,0 +1,285 @@ +Attribute VB_Name = "Process" +' From Microsoft Knowledge Base Article - Q129796 and 173085 +' +' + +Public Type ProcessOutput + ret As Long 'return value + out As String 'whatever was printed to stdout + err As String 'whatever was printed to stderr +End Type + +Public Type ProcessContext + outHnd As Long 'handler for the redirected output + outName As String 'name of the file to which output is redirected +End Type + +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 + +Private Type SECURITY_ATTRIBUTES + nLength As Long + lpSecurityDescriptor As Long + bInheritHandle As Long +End Type + +Public Type OVERLAPPED + Internal As Long + InternalHigh As Long + offset As Long + OffsetHigh As Long + hEvent As Long +End Type + +Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal _ + hHandle As Long, ByVal dwMilliseconds As Long) As Long + +Private Declare Function CreateProcessA Lib "kernel32" (ByVal _ + lpApplicationName As String, 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 String, _ + lpStartupInfo As STARTUPINFO, lpProcessInformation As _ + PROCESS_INFORMATION) As Long + +Private Declare Function CloseHandle Lib "kernel32" _ + (ByVal hObject As Long) As Long + +Private Declare Function GetExitCodeProcess Lib "kernel32" _ + (ByVal hProcess As Long, lpExitCode As Long) As Long + +Private Declare Function CreatePipe Lib "kernel32" _ + (phReadPipe As Long, phWritePipe As Long, _ + lpPipeAttributes As Any, ByVal nSize As Long) As Long + +Public Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" _ + (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, _ + ByVal dwShareMode As Long, lpSecurityAttributes As SECURITY_ATTRIBUTES, _ + ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, _ + ByVal hTemplateFile As Long) As Long + +Public Declare Function DeleteFile Lib "kernel32" Alias "DeleteFileA" _ + (ByVal lpFileName As String) As Long + +Private Declare Function ReadFile Lib "kernel32" _ + (ByVal hFile As Long, ByVal lpBuffer As String, _ + ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, _ + ByVal lpOverlapped As Any) As Long + +Public Declare Function GetTempFileName Lib "kernel32" Alias "GetTempFileNameA" _ + (ByVal lpszPath As String, ByVal lpPrefixString As String, _ + ByVal wUnique As Long, ByVal lpTempFileName As String) As Long + +Public Declare Function GetFileSize Lib "kernel32" _ + (ByVal hFile As Long, lpFileSizeHigh As Long) As Long + +Public Declare Function SetFilePointer Lib "kernel32" _ + (ByVal hFile As Long, ByVal lDistanceToMove As Long, _ + lpDistanceToMoveHigh As Long, ByVal dwMoveMethod As Long) As Long + + + +Private Const NORMAL_PRIORITY_CLASS = &H20& +Private Const STARTF_USESTDHANDLES = &H100& +Private Const INFINITE = -1& + +Public Const GENERIC_WRITE = &H40000000 +Public Const GENERIC_READ = &H80000000 + +Public Const FILE_SHARE_READ = &H1 +Public Const FILE_SHARE_WRITE = &H2 +Public Const FILE_SHARE_DELETE = &H4 + +Public Const CREATE_ALWAYS = 2 + +Public Const INVALID_HANDLE_VALUE = -1 + +Public Const FILE_FLAG_DELETE_ON_CLOSE = &H4000000 +Public Const FILE_FLAG_OVERLAPPED = &H40000000 + +Public Const FILE_ATTRIBUTE_NORMAL = &H80 +Public Const FILE_ATTRIBUTE_TEMPORARY = &H100 + +Public Const FILE_BEGIN = 0 + +Public Const MAX_PATH = 260 + +'my own constants +Private Const STDOUT_PIPE = 1 +Private Const STDOUT_IN_PIPE = 2 +Private Const STDERR_PIPE = 3 +Private Const STDERR_IN_PIPE = 4 + +Private Const READ_BUFF_SIZE = 256 + + +' +' Pending issue here: waiting for the called process is infinite +' The output is intercepted only if doWait and doOutput are set to true +' +Public Function ExecCmd(cmdline$, doWait As Boolean, doOutput As Boolean) As ProcessOutput + Dim ret As Long + Dim res As ProcessOutput + Dim ctx As ProcessContext + ' + Dim proc As PROCESS_INFORMATION + Dim start As STARTUPINFO + ' + Dim doPipes As Boolean + ' + Dim cnt As Long, atpt As Long + Dim buff As String * READ_BUFF_SIZE + + doPipes = (doWait = True) And (doOutput = True) + ctx.outName = String(MAX_PATH, Chr$(0)) + + ' Initialize the STARTUPINFO structure: + start.cb = Len(start) + + If doPipes Then + OpenContext ctx, True + start.dwFlags = STARTF_USESTDHANDLES + start.hStdError = ctx.outHnd + End If + + ' Start the shelled application: + ret& = CreateProcessA(vbNullString, cmdline$, 0&, 0&, 1&, _ + NORMAL_PRIORITY_CLASS, 0&, vbNullString, start, proc) + + If ret <> 1 Then + CloseContext ctx, False + err.Raise 12001, , "CreateProcess failed. Error: " & err.LastDllError + End If + + ' Wait for the shelled application to finish: + If doWait = True Then + ret& = WaitForSingleObject(proc.hProcess, INFINITE) + Call GetExitCodeProcess(proc.hProcess, res.ret&) + + Call CloseHandle(proc.hThread) + Call CloseHandle(proc.hProcess) + + 'read the dump of the stderr, non-blocking + If doPipes Then + ret& = GetFileSize(ctx.outHnd, 0) + 'we consider that not being able to read the stderr log is not a fatal error + If ret <> -1 Then + ret = SetFilePointer(ctx.outHnd, 0, 0, FILE_BEGIN) + If ret = 0 Then + Do + ret = ReadFile(ctx.outHnd, buff, READ_BUFF_SIZE, cnt, 0&) + res.err = res.err & Left$(buff, cnt) + Loop While ret <> 0 And cnt <> 0 + Else + MsgBox "SetFilePointer failed. Error: " & err.LastDllError & " " & err.Description + End If + Else + MsgBox "GetFileSize failed. Error: " & err.LastDllError & " " & err.Description + End If + + CloseContext ctx, False + End If + + End If + + ExecCmd = res +End Function + +Private Sub OpenContext(ByRef Context As ProcessContext, doError As Boolean) + + Dim sa As SECURITY_ATTRIBUTES + Dim msg As String + + ' Initialize the SECURITY_ATRIBUTES info + sa.nLength = Len(sa) + sa.bInheritHandle = 1& + sa.lpSecurityDescriptor = 0& + + ret& = GetTempFileName(".", "err", 0, Context.outName) + If ret = 0 Then + msg = "GetTempFileName failed for stderr. Error: " & err.LastDllError + If doError = True Then + err.Raise 12000, , msg + Else + MsgBox msg + End If + End If + + Context.outHnd = CreateFile(Context.outName, _ + GENERIC_WRITE Or GENERIC_READ, _ + FILE_SHARE_WRITE Or FILE_SHARE_READ Or FILE_SHARE_DELETE, _ + sa, CREATE_ALWAYS, _ + FILE_ATTRIBUTE_TEMPORARY, _ + FILE_FLAG_DELETE_ON_CLOSE) + + If Context.outHnd = INVALID_HANDLE_VALUE Then + msg = "CreateFile failed for stderr. Error: " & err.LastDllError + If doError = True Then + err.Raise 12000, , msg + Else + MsgBox msg + End If + End If + +End Sub + +Private Sub CloseContext(ByRef Context As ProcessContext, doError As Boolean) + Dim msg As String + If Context.outHnd <> 0 Then + CloseHandle Context.outHnd + End If + If Not IsNull(Context.outName) Then + 'delete the file + ret = DeleteFile(Context.outName) + If ret = 0 Then + msg = "DeleteFile failed. Error: " & err.LastDllError & Chr(13) & _ + "You have a temporary file at " & pathBuff + If doError = True Then + err.Raise 12000, , msg + Else + MsgBox msg + End If + End If + End If +End Sub + +Private Sub ClosePipes(ByRef Pipes() As Long, Size As Integer) + Dim i As Integer + For i = 0 To Size + ClosePipe Pipes, i + Next i +End Sub + +Private Sub ClosePipe(ByRef Pipes() As Long, Pos As Integer) + + If Pipes(Pos) <> 0 Then + CloseHandle Pipes(Pos) + Pipes(Pos) = 0 + End If +End Sub + diff --git a/windows/cmd/gvui/Registry.bas b/windows/cmd/gvui/Registry.bas new file mode 100644 index 000000000..f97b232ac --- /dev/null +++ b/windows/cmd/gvui/Registry.bas @@ -0,0 +1,118 @@ +Attribute VB_Name = "Registry" +' From the VBWorld website +' Detailed Registry access through win32 apis +' + +Public Const HKEY_CLASSES_ROOT = &H80000000 +Public Const HKEY_CURRENT_USER = &H80000001 +Public Const HKEY_LOCAL_MACHINE = &H80000002 +Public Const HKEY_USERS = &H80000003 +Public Const HKEY_CURRENT_CONFIG = &H80000005 +Public Const HKEY_DYN_DATA = &H80000006 +Public Const REG_SZ = 1 'Unicode nul terminated string +Public Const REG_BINARY = 3 'Free form binary +Public Const REG_DWORD = 4 '32-bit number +Public Const ERROR_SUCCESS = 0& + +Public Declare Function RegCloseKey Lib "advapi32.dll" _ +(ByVal hKey As Long) As Long + +Public Declare Function RegCreateKey Lib "advapi32.dll" _ +Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey _ +As String, phkResult As Long) As Long + +'Public Declare Function RegDeleteKey Lib "advapi32.dll" _ +'Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey _ +'As String) As Long + +'Public Declare Function RegDeleteValue Lib "advapi32.dll" _ +'Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal _ +'lpValueName As String) As Long + +Public Declare Function RegOpenKey Lib "advapi32.dll" _ +Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey _ +As String, phkResult As Long) As Long + +Public Declare Function RegQueryValueEx Lib "advapi32.dll" _ +Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName _ +As String, ByVal lpReserved As Long, lpType As Long, lpData _ +As Any, lpcbData 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 + + +Public Function GetSettingString(hKey As Long, _ + strPath As String, _ + strValue As String, _ + Optional Default As String) As String + Dim hCurKey As Long + Dim lResult As Long + Dim lValueType As Long + Dim strBuffer As String + Dim lDataBufferSize As Long + Dim intZeroPos As Integer + Dim lRegResult As Long + + 'Set up default value + If Not IsEmpty(Default) Then + GetSettingString = Default + Else + GetSettingString = "" + End If + + lRegResult = RegOpenKey(hKey, strPath, hCurKey) + lRegResult = RegQueryValueEx(hCurKey, strValue, 0&, _ + lValueType, ByVal 0&, lDataBufferSize) + + If lRegResult = ERROR_SUCCESS Then + If lValueType = REG_SZ Then + strBuffer = String(lDataBufferSize, " ") + lResult = RegQueryValueEx(hCurKey, strValue, 0&, 0&, _ + ByVal strBuffer, lDataBufferSize) + intZeroPos = InStr(strBuffer, Chr$(0)) + If intZeroPos > 0 Then + GetSettingString = Left$(strBuffer, intZeroPos - 1) + Else + GetSettingString = strBuffer + End If + End If + Else + Err.Raise 5013, "Registry", "Unable to find get key value" + End If + + lRegResult = RegCloseKey(hCurKey) +End Function + +Public Sub CreateKey(hKey As Long, strPath As String) + + Dim hCurKey As Long + Dim lRegResult As Long + + lRegResult = RegCreateKey(hKey, strPath, hCurKey) + If lRegResult <> ERROR_SUCCESS Then + Err.Raise 5013, "Registry", "Unable to find create registry key" + End If + lRegResult = RegCloseKey(hCurKey) + +End Sub + +Public Sub SaveSettingString(hKey As Long, _ + strPath As String, _ + strValue As String, _ + strData As String) + Dim hCurKey As Long + Dim lRegResult As Long + + lRegResult = RegCreateKey(hKey, strPath, hCurKey) + lRegResult = RegSetValueEx(hCurKey, strValue, 0, REG_SZ, _ + ByVal strData, Len(strData)) + + If lRegResult <> ERROR_SUCCESS Then + Err.Raise 5013, "Registry", "Unable to find save registry settings" + End If + + lRegResult = RegCloseKey(hCurKey) +End Sub