Open, Save, and Folder dialogs using Pipecom

[SpriggsySpriggs]

No longer needing to use script files or turning off execution policies. Now you can use pipecom to call up common dialogs! Each function uses one string call to PowerShell to generate the dialog. Very efficient. The GetOpenFileNames sub can be used to return an array of files selected. The other three are self-explanatory.

Code: QB64: [Select]

1. Option _Explicit
2.  
3. Print GetOpenFileName("This is a test", _Dir$("desktop"), "txt files (*.txt)|*.txt|All files (*.*)|*.*", 2)
4. 'Dim As String savefile
5. 'savefile = GetSaveFileName("Save test", _CWD$, "txt files (*.txt)|*.txt|All files (*.*)|*.*", 1)
6. 'If savefile <> "" Then
7. '    Open savefile For Output As #1
8. '    Print #1, Chr$(34) + "Success! Success! We've done it! We've done it!" + Chr$(34)
9. '    Print #1, Chr$(9) + Chr$(9) + Chr$(9) + "-Every diplomatic leader in The Batman Movie";
10. '    Close
11. 'End If
12.  
13. 'Print GetFolderName("Pick a folder")
14.  
15. 'ReDim As String filelist(1 To 1)
16. 'GetOpenFileNames "Pick multiple files", _Dir$("desktop"), "txt files (*.txt)|*.txt|All files (*.*)|*.*", 1, filelist()
17.  
18. 'Dim x
19. 'For x = LBound(filelist) To UBound(filelist)
20. '    Print filelist(x)
21. 'Next
22.  
23. Function GetOpenFileName$ (Title As String, InitialDir As String, Filter As String, FilterIndex As Long)
24.     Dim As String cmd, stdout, stderr
25.     Dim As Long exit_code
26.     If Mid$(InitialDir, Len(InitialDir) - 1) <> "\" Then InitialDir = InitialDir + "\"
27.     cmd = "PowerShell Add-Type -AssemblyName System.Windows.Forms;$FileBrowser = New-Object System.Windows.Forms.OpenFileDialog -Property @{ Title = '" + Chr$(34) + Title + Chr$(34) + "'; InitialDirectory = '" + Chr$(34) + InitialDir + Chr$(34) + "'; Filter = '" + Chr$(34) + Filter + Chr$(34) + "'; FilterIndex = '" + Chr$(34) + LTrim$(Str$(FilterIndex)) + Chr$(34) + "'; };$null = $FileBrowser.ShowDialog();$FileBrowser.FileName;exit $LASTEXITCODE"
28.     exit_code = pipecom(cmd, stdout, stderr)
29.     If stdout <> "" Then GetOpenFileName = Mid$(stdout, 1, Len(stdout) - 1)
30. End Function
31.  
32. Sub GetOpenFileNames (Title As String, InitialDir As String, Filter As String, FilterIndex As Long, filenames() As String)
33.     Dim As String cmd, stdout, stderr
34.     Dim As Long exit_code
35.     If Mid$(InitialDir, Len(InitialDir) - 1) <> "\" Then InitialDir = InitialDir + "\"
36.     cmd = "PowerShell Add-Type -AssemblyName System.Windows.Forms;$FileBrowser = New-Object System.Windows.Forms.OpenFileDialog -Property @{ Title = '" + Chr$(34) + Title + Chr$(34) + "'; InitialDirectory = '" + Chr$(34) + InitialDir + Chr$(34) + "'; Filter = '" + Chr$(34) + Filter + Chr$(34) + "'; FilterIndex = '" + Chr$(34) + LTrim$(Str$(FilterIndex)) + Chr$(34) + "'; Multiselect = 'true'; };$null = $FileBrowser.ShowDialog();$FileBrowser.FileNames;exit $LASTEXITCODE"
37.     exit_code = pipecom(cmd, stdout, stderr)
38.     If stdout <> "" Then
39.         stdout = Mid$(stdout, 1, Len(stdout) - 1)
40.         If InStr(stdout, Chr$(10)) = 0 Then
41.             filenames(1) = stdout
42.         Else
43.             String.Split stdout, Chr$(10), filenames()
44.         End If
45.     End If
46. End Sub
47.  
48. Function GetSaveFileName$ (Title As String, InitialDir As String, Filter As String, FilterIndex As Long)
49.     Dim As String cmd, stdout, stderr
50.     Dim As Long exit_code
51.     If Mid$(InitialDir, Len(InitialDir) - 1) <> "\" Then InitialDir = InitialDir + "\"
52.     cmd = "PowerShell Add-Type -AssemblyName System.Windows.Forms;$FileBrowser = New-Object System.Windows.Forms.SaveFileDialog -Property @{ Title = '" + Chr$(34) + Title + Chr$(34) + "'; InitialDirectory = '" + Chr$(34) + InitialDir + Chr$(34) + "'; Filter = '" + Chr$(34) + Filter + Chr$(34) + "'; FilterIndex = '" + Chr$(34) + LTrim$(Str$(FilterIndex)) + Chr$(34) + "'; };$null = $FileBrowser.ShowDialog();$FileBrowser.FileName;exit $LASTEXITCODE"
53.     exit_code = pipecom(cmd, stdout, stderr)
54.     If stdout <> "" Then GetSaveFileName = Mid$(stdout, 1, Len(stdout) - 1)
55. End Function
56.  
57. Function GetFolderName$ (Title As String)
58.     Dim As String cmd, stdout, stderr
59.     Dim As Long exit_code
60.     cmd = "PowerShell Add-Type -AssemblyName System.Windows.Forms;$FolderBrowser = New-Object System.Windows.Forms.FolderBrowserDialog -Property @{ Description = '" + Chr$(34) + Title + Chr$(34) + "'; ShowNewFolderButton = 'true'; };$null = $FolderBrowser.ShowDialog();$FolderBrowser.SelectedPath;exit $LASTEXITCODE"
61.     exit_code = pipecom(cmd, stdout, stderr)
62.     If stdout <> "" Then GetFolderName = Mid$(stdout, 1, Len(stdout) - 1)
63. End Function
64.  
65. Sub String.Split (Expression As String, delimiter As String, StorageArray() As String)
66.     Dim copy As String, p As Long, curpos As Long, arrpos As Long, dpos As Long
67.     copy = Expression
68.     If delimiter = " " Then
69.         copy = RTrim$(LTrim$(copy))
70.         p = InStr(copy, "  ")
71.         While p > 0
72.             copy = Mid$(copy, 1, p - 1) + Mid$(copy, p + 1)
73.             p = InStr(copy, "  ")
74.         Wend
75.     End If
76.     curpos = 1
77.     arrpos = UBound(StorageArray)
78.     dpos = InStr(curpos, copy, delimiter)
79.     Do Until dpos = 0
80.         StorageArray(UBound(StorageArray)) = Mid$(copy, curpos, dpos - curpos)
81.         ReDim _Preserve StorageArray(UBound(StorageArray) + 1) As String
82.         curpos = dpos + Len(delimiter)
83.         dpos = InStr(curpos, copy, delimiter)
84.     Loop
85.     StorageArray(UBound(StorageArray)) = Mid$(copy, curpos)
86.     ReDim _Preserve StorageArray(UBound(StorageArray)) As String
87. End Sub
88.  
89. '$INCLUDE:'pipecomqb64.bas'

pipecomqb64.bas:

Code: QB64: [Select]

1. Function pipecom& (cmd As String, stdout As String, stderr As String)
2.     $If WIN Then
3.         Type SECURITY_ATTRIBUTES
4.             As Long nLength
5.             $If 64BIT Then
6.                 As Long padding
7.             $End If
8.             As _Offset lpSecurityDescriptor
9.             As Long bInheritHandle
10.             $If 64BIT Then
11.                 As Long padding2
12.             $End If
13.         End Type
14.  
15.         Type STARTUPINFO
16.             As Long cb
17.             $If 64BIT Then
18.                 As Long padding
19.             $End If
20.             As _Offset lpReserved, lpDesktop, lpTitle
21.             As Long dwX, dwY, dwXSize, dwYSize, dwXCountChars, dwYCountChars, dwFillAttribute, dwFlags
22.             As Integer wShowWindow, cbReserved2
23.             $If 64BIT Then
24.                 As Long padding2
25.             $End If
26.             As _Offset lpReserved2, hStdInput, hStdOutput, hStdError
27.         End Type
28.  
29.         Type PROCESS_INFORMATION
30.             As _Offset hProcess, hThread
31.             As Long dwProcessId
32.             $If 64BIT Then
33.                 As Long padding
34.             $End If
35.         End Type
36.  
37.         Const STARTF_USESTDHANDLES = &H00000100
38.         Const CREATE_NO_WINDOW = &H8000000
39.  
40.         Const INFINITE = 4294967295
41.         Const WAIT_FAILED = &HFFFFFFFF
42.  
43.         Declare CustomType Library
44.             Function CreatePipe%% (ByVal hReadPipe As _Offset, Byval hWritePipe As _Offset, Byval lpPipeAttributes As _Offset, Byval nSize As Long)
45.             Function CreateProcess%% Alias CreateProcessA (ByVal lpApplicationName As _Offset, Byval lpCommandLine As _Offset, Byval lpProcessAttributes As _Offset, Byval lpThreadAttributes As _Offset, Byval bInheritHandles As Integer, Byval dwCreationFlags As Long, Byval lpEnvironment As _Offset, Byval lpCurrentDirectory As _Offset, Byval lpStartupInfor As _Offset, Byval lpProcessInformation As _Offset)
46.             Function GetExitCodeProcess%% (ByVal hProcess As _Offset, Byval lpExitCode As _Offset)
47.             Function HandleClose%% Alias CloseHandle (ByVal hObject As _Offset)
48.             Function ReadFile%% (ByVal hFile As _Offset, Byval lpBuffer As _Offset, Byval nNumberOfBytesToRead As Long, Byval lpNumberOfBytesRead As _Offset, Byval lpOverlapped As _Offset)
49.             Function WaitForSingleObject& (ByVal hHandle As _Offset, Byval dwMilliseconds As Long)
50.         End Declare
51.  
52.         Dim As _Byte ok: ok = 1
53.         Dim As _Offset hStdOutPipeRead, hStdOutPipeWrite, hStdReadPipeError, hStdOutPipeError
54.         Dim As SECURITY_ATTRIBUTES sa: sa.nLength = Len(sa): sa.lpSecurityDescriptor = 0: sa.bInheritHandle = 1
55.  
56.         If CreatePipe(_Offset(hStdOutPipeRead), _Offset(hStdOutPipeWrite), _Offset(sa), 0) = 0 Then
57.             pipecom = -1
58.             Exit Function
59.         End If
60.  
61.         If CreatePipe(_Offset(hStdReadPipeError), _Offset(hStdOutPipeError), _Offset(sa), 0) = 0 Then
62.             pipecom = -1
63.             Exit Function
64.         End If
65.  
66.         Dim As STARTUPINFO si
67.         si.cb = Len(si)
68.         si.dwFlags = STARTF_USESTDHANDLES
69.         si.hStdError = hStdOutPipeError
70.         si.hStdOutput = hStdOutPipeWrite
71.         si.hStdInput = 0
72.         Dim As PROCESS_INFORMATION pi
73.         Dim As _Offset lpApplicationName
74.         Dim As String fullcmd: fullcmd = "cmd /c " + cmd + Chr$(0)
75.         Dim As String lpCommandLine: lpCommandLine = fullcmd
76.         Dim As _Offset lpProcessAttributes, lpThreadAttributes
77.         Dim As Integer bInheritHandles: bInheritHandles = 1
78.         Dim As Long dwCreationFlags: dwCreationFlags = CREATE_NO_WINDOW
79.         Dim As _Offset lpEnvironment, lpCurrentDirectory
80.         ok = CreateProcess(lpApplicationName,_
81.         _Offset(lpCommandLine),_
82.         lpProcessAttributes,_
83.         lpThreadAttributes,_
84.         bInheritHandles,_
85.         dwCreationFlags,_
86.         lpEnvironment,_
87.         lpCurrentDirectory,_
88.         _Offset(si),_
89.         _Offset(pi))
90.         If ok = 0 Then
91.             pipecom = -1
92.             Exit Function
93.         End If
94.  
95.         ok = HandleClose(hStdOutPipeWrite)
96.         ok = HandleClose(hStdOutPipeError)
97.  
98.         Dim As String buf: buf = Space$(4096 + 1)
99.         Dim As Long dwRead
100.         While ReadFile(hStdOutPipeRead, _Offset(buf), 4096, _Offset(dwRead), 0) <> 0 And dwRead > 0
101.             buf = Mid$(buf, 1, dwRead)
102.             GoSub RemoveChr13
103.             stdout = stdout + buf
104.             buf = Space$(4096 + 1)
105.         Wend
106.  
107.         While ReadFile(hStdReadPipeError, _Offset(buf), 4096, _Offset(dwRead), 0) <> 0 And dwRead > 0
108.             buf = Mid$(buf, 1, dwRead)
109.             GoSub RemoveChr13
110.             stderr = stderr + buf
111.             buf = Space$(4096 + 1)
112.         Wend
113.  
114.         Dim As Long exit_code, ex_stat
115.         If WaitForSingleObject(pi.hProcess, INFINITE) <> WAIT_FAILED Then
116.             If GetExitCodeProcess(pi.hProcess, _Offset(exit_code)) Then
117.                 ex_stat = 1
118.             End If
119.         End If
120.  
121.         ok = HandleClose(hStdOutPipeRead)
122.         ok = HandleClose(hStdReadPipeError)
123.         If ex_stat = 1 Then
124.             pipecom = exit_code
125.         Else
126.             pipecom = -1
127.         End If
128.  
129.         Exit Function
130.  
131.         RemoveChr13:
132.         Dim As Long j
133.         j = InStr(buf, Chr$(13))
134.         Do While j
135.             buf = Left$(buf, j - 1) + Mid$(buf, j + 1)
136.             j = InStr(buf, Chr$(13))
137.         Loop
138.         Return
139.     $Else
140.         Declare CustomType Library
141.         Function popen%& (cmd As String, readtype As String)
142.         Function feof& (ByVal stream As _Offset)
143.         Function fgets$ (str As String, Byval n As Long, Byval stream As _Offset)
144.         Function pclose& (ByVal stream As _Offset)
145.         End Declare
146.  
147.         Declare Library
148.         Function WEXITSTATUS& (ByVal stat_val As Long)
149.         End Declare
150.  
151.         Dim As String pipecom_buffer
152.         Dim As _Offset stream
153.  
154.         Dim buffer As String * 4096
155.         If _FileExists("pipestderr") Then
156.         Kill "pipestderr"
157.         End If
158.         stream = popen(cmd + " 2>pipestderr", "r")
159.         If stream Then
160.         While feof(stream) = 0
161.         If fgets(buffer, 4096, stream) <> "" And feof(stream) = 0 Then
162.         stdout = stdout + Mid$(buffer, 1, InStr(buffer, Chr$(0)) - 1)
163.         End If
164.         Wend
165.         Dim As Long status, exit_code
166.         status = pclose(stream)
167.         exit_code = WEXITSTATUS(status)
168.         If _FileExists("pipestderr") Then
169.         Dim As Integer errfile
170.         errfile = FreeFile
171.         Open "pipestderr" For Binary As #errfile
172.         If LOF(errfile) > 0 Then
173.         stderr = Space$(LOF(errfile))
174.         Get #errfile, , stderr
175.         End If
176.         Close #errfile
177.         Kill "pipestderr"
178.         End If
179.         pipecom = exit_code
180.         Else
181.         pipecom = -1
182.         End If
183.     $End If
184. End Function
185.  
186. Function pipecom_lite$ (cmd As String)
187.     Dim As Long a
188.     Dim As String stdout, stderr
189.     a = pipecom(cmd, stdout, stderr)
190.     If stderr <> "" Then
191.         pipecom_lite = stderr
192.     Else
193.         pipecom_lite = stdout
194.     End If
195. End Function

[bplus]

Oh where was this when I was putting together oh? :)

Definitely got to check this out, multi-select you say? That would be fabulous!

[SpriggsySpriggs]

Definitely got to check this out, multi-select you say? That would be fabulous!

@bplus Just updated the original code. Had to change the logic for the multi-select. Now it works right. The array wasn't getting anything if only one file was selected. Now it works properly.

EDIT: Changed it again because InitialDir needs a backslash on the end in order to be valid and didn't want people to have to remember to put one.