How to retrieve CAC/Smart Card info with reader? - vba

I'm in the Marines and am trying to make a database to manage an armory with MS Access and SharePoint Lists. I need to add new people when they check in with me so I can immediately assign them a weapon. Entering their information manually is cool, but they have a CAC/Smart Card with all this info on it and I want to see if I can automate this step.
There is an ActivClient Agent application I can open and see all of my info. There's a section called "My Personal Info" with two tabs that have the data I'm trying to get (first name, middle, last, branch, rank, EDIPI). I've recently learned that VBA can use Windows APIs (I also just learned that these exist). The issue I'm having is figuring how to use the resources that are installed on the government computer to access the CAC information. We cannot download any tools or libraries on these computers, it has to be already installed.
I've found winscard.h has some functions that seem like they would be useful, but I don't know how to use them. Can I use winscard.h functions to access and read the data from a second CAC connected to my computer? Should I find a different approach, like making my own .dll that has the functions to do everything I need with the card? I've been learning to program for a bit now, but when it comes to niche topics like this, I'm unsure how to approach the problem the best way.
The steps would generally be: user logs into computer using CAC, open the Access database, navigate to the check-in form, insert the new-join's card into the second card reader, somehow get data from the card, auto-fill the form with the fresh data, and finish doing whatever I make it do. The step I'm stuck on is strictly getting the data from the card.
OS: Windows 10 only
Software: MS Access 32 and 64 bit
Hardware: any Smart Card reader. I plan to share this software with a lot of people that won't have the same exact equipment except for the government computer. Most of the computers have a built in reader, and sometimes they might have standalone readers or keyboards with built in readers.
Alternatively, would it be easier to get a scanner and scan the barcode on the card? I believe the barcode will have the same information I need. Until I can get a scanner approved for use, I would still like to try to use the second Smart Card reader approach since that's what I have right now. Can anything be done with ActivClient or its resources? It uses ac.scapi.scmd.dll, acpkcs211.dll, acbsi21.dll, and acpivapi.dll. I can't find documentation for any of these things. It seems like one or all of them can somehow be used to get the data I want.
Edit:
I followed some of the links shared in the comments and have the following code:
Option Explicit
Option Compare Database
Public AuthDict As Scripting.Dictionary
Public Const SCARD_SCOPE_USER As Long = &H0
Public Const SCARD_SCOPE_SYSTEM As Long = &H2
Public Const SCARD_SHARE_SHARED As Long = &H2
Public Const SCARD_SHARE_EXCLUSIVE As Long = &H1
Public Const SCARD_SHARE_DIRECT As Long = &H3
Public Const SCARD_PROTOCOL_T0 As Long = &H1
Public Const SCARD_PROTOCOL_T1 As Long = &H2
Public Const SCARD_DEFAULT_READERS As String = "SCard$DefaultReaders\000"
Public Const SCARD_ALL_READERS As String = "SCard$AllReaders\000"
Public Declare PtrSafe Function SCardEstablishContext Lib "winscard.dll" ( _
ByVal dwScope As Long, _
ByVal pvReserved1 As LongPtr, _
ByVal pvReserved2 As LongPtr, _
ByRef phContext As LongPtr _
) As Long
Public Declare PtrSafe Function SCardIsValidContext Lib "winscard.dll" ( _
ByVal hContext As LongPtr _
) As Long
Public Declare PtrSafe Function SCardReleaseContext Lib "winscard.dll" ( _
ByVal hContext As LongPtr) As Long
Public Declare PtrSafe Function SCardConnectA Lib "winscard.dll" ( _
ByVal hContext As LongPtr, _
szReader As LongPtr, _
dwShareMode As LongPtr, _
dwPreferredProtocols As LongPtr, _
phCard As LongPtr, _
pdwActiveProtocol) As LongPtr
Public Function SCardAuthCode(lReturn As Long)
'Credit: https://stackoverflow.com/questions/67199032/access-vba-and-smart-cards-whats-the-trick
AuthDict.RemoveAll
Dim hreturn As String, hc As String, hd As String
hreturn = "0x" & Right("0000000" & Hex(lReturn), 8)
Select Case hreturn
Case "0x00000000": hc = "SCARD_S_SUCCESS": hd = "No error was encountered."
Case "0x00000006": hc = "ERROR_INVALID_HANDLE": hd = "The handle is invalid."
Case "0x00000109": hc = "ERROR_BROKEN_PIPE": hd = "The client attempted a smart card operation in a remote session, such as a client session running on a terminal server, and the operating system in use does not support smart card redirection."
Case "0x80100001": hc = "SCARD_F_INTERNAL_ERROR": hd = "An internal consistency check failed."
Case "0x80100002": hc = "SCARD_E_CANCELLED": hd = "The action was canceled by an SCardCancel request."
Case "0x80100003": hc = "SCARD_E_INVALID_HANDLE": hd = "The supplied handle was not valid."
Case "0x80100004": hc = "SCARD_E_INVALID_PARAMETER": hd = "One or more of the supplied parameters could not be properly interpreted."
Case "0x80100005": hc = "SCARD_E_INVALID_TARGET": hd = "Registry startup information is missing or not valid."
Case "0x80100006": hc = "SCARD_E_NO_MEMORY": hd = "Not enough memory available to complete this command."
Case "0x80100007": hc = "SCARD_F_WAITED_TOO_LONG": hd = "An internal consistency timer has expired."
Case "0x80100008": hc = "SCARD_E_INSUFFICIENT_BUFFER": hd = "The data buffer for returned data is too small for the returned data."
Case "0x80100009": hc = "SCARD_E_UNKNOWN_READER": hd = "The specified reader name is not recognized."
Case "0x8010000A": hc = "SCARD_E_TIMEOUT": hd = "The user-specified time-out value has expired."
Case "0x8010000B": hc = "SCARD_E_SHARING_VIOLATION": hd = "The smart card cannot be accessed because of other outstanding connections."
Case "0x8010000C": hc = "SCARD_E_NO_SMARTCARD": hd = "The operation requires a smart card, but no smart card is currently in the device."
Case "0x8010000D": hc = "SCARD_E_UNKNOWN_CARD": hd = "The specified smart card name is not recognized."
Case "0x8010000E": hc = "SCARD_E_CANT_DISPOSE": hd = "The system could not dispose of the media in the requested manner."
Case "0x8010000F": hc = "SCARD_E_PROTO_MISMATCH": hd = "The requested protocols are incompatible with the protocol currently in use with the card."
Case "0x80100010": hc = "SCARD_E_NOT_READY": hd = "The reader or card is not ready to accept commands."
Case "0x80100011": hc = "SCARD_E_INVALID_VALUE": hd = "One or more of the supplied parameter values could not be properly interpreted."
Case "0x80100012": hc = "SCARD_E_SYSTEM_CANCELLED": hd = "The action was canceled by the system, presumably to log off or shut down."
Case "0x80100013": hc = "SCARD_F_COMM_ERROR": hd = "An internal communications error has been detected."
Case "0x80100014": hc = "SCARD_F_UNKNOWN_ERROR": hd = "An internal error has been detected, but the source is unknown."
Case "0x80100015": hc = "SCARD_E_INVALID_ATR": hd = "An ATR string obtained from the registry is not a valid ATR string."
Case "0x80100016": hc = "SCARD_E_NOT_TRANSACTED": hd = "An attempt was made to end a nonexistent transaction."
Case "0x80100017": hc = "SCARD_E_READER_UNAVAILABLE": hd = "The specified reader is not currently available for use."
Case "0x80100018": hc = "SCARD_P_SHUTDOWN": hd = "The operation has been aborted to allow the server application to exit."
Case "0x80100019": hc = "SCARD_E_PCI_TOO_SMALL": hd = "The PCI receive buffer was too small."
Case "0x8010001A": hc = "SCARD_E_READER_UNSUPPORTED": hd = "The reader driver does not meet minimal requirements for support."
Case "0x8010001B": hc = "SCARD_E_DUPLICATE_READER": hd = "The reader driver did not produce a unique reader name."
Case "0x8010001C": hc = "SCARD_E_CARD_UNSUPPORTED": hd = "The smart card does not meet minimal requirements for support."
Case "0x8010001D": hc = "SCARD_E_NO_SERVICE": hd = "The smart card resource manager is not running."
Case "0x8010001E": hc = "SCARD_E_SERVICE_STOPPED": hd = "The smart card resource manager has shut down."
Case "0x8010001F": hc = "SCARD_E_UNEXPECTED": hd = "An unexpected card error has occurred."
Case "0x80100020": hc = "SCARD_E_ICC_INSTALLATION": hd = "No primary provider can be found for the smart card."
Case "0x80100021": hc = "SCARD_E_ICC_CREATEORDER": hd = "The requested order of object creation is not supported."
Case "0x80100022": hc = "SCARD_E_UNSUPPORTED_FEATURE": hd = "This smart card does not support the requested feature."
Case "0x80100023": hc = "SCARD_E_DIR_NOT_FOUND": hd = "The specified directory does not exist in the smart card."
Case "0x80100024": hc = "SCARD_E_FILE_NOT_FOUND": hd = "The specified file does not exist in the smart card."
Case "0x80100025": hc = "SCARD_E_NO_DIR": hd = "The supplied path does not represent a smart card directory."
Case "0x80100026": hc = "SCARD_E_NO_FILE": hd = "The supplied path does not represent a smart card file."
Case "0x80100027": hc = "SCARD_E_NO_ACCESS": hd = "Access is denied to the file."
Case "0x80100028": hc = "SCARD_E_WRITE_TOO_MANY": hd = "An attempt was made to write more data than would fit in the target object."
Case "0x80100029": hc = "SCARD_E_BAD_SEEK": hd = "An error occurred in setting the smart card file object pointer."
Case "0x8010002A": hc = "SCARD_E_INVALID_CHV": hd = "The supplied PIN is incorrect."
Case "0x8010002B": hc = "SCARD_E_UNKNOWN_RES_MNG": hd = "An unrecognized error code was returned."
Case "0x8010002C": hc = "SCARD_E_NO_SUCH_CERTIFICATE": hd = "The requested certificate does not exist."
Case "0x8010002D": hc = "SCARD_E_CERTIFICATE_UNAVAILABLE": hd = "The requested certificate could not be obtained."
Case "0x8010002E": hc = "SCARD_E_NO_READERS_AVAILABLE": hd = "No smart card reader is available."
Case "0x8010002F": hc = "SCARD_E_COMM_DATA_LOST": hd = "A communications error with the smart card has been detected."
Case "0x80100030": hc = "SCARD_E_NO_KEY_CONTAINER": hd = "The requested key container does not exist on the smart card."
Case "0x80100031": hc = "SCARD_E_SERVER_TOO_BUSY": hd = "The smart card resource manager is too busy to complete this operation."
Case "0x80100032": hc = "SCARD_E_PIN_CACHE_EXPIRED": hd = "The smart card PIN cache has expired."
Case "0x80100033": hc = "SCARD_E_NO_PIN_CACHE": hd = "The smart card PIN cannot be cached."
Case "0x80100034": hc = "SCARD_E_READ_ONLY_CARD": hd = "The smart card is read-only and cannot be written to."
Case "0x80100065": hc = "SCARD_W_UNSUPPORTED_CARD": hd = "The reader cannot communicate with the card, due to ATR string configuration conflicts."
Case "0x80100066": hc = "SCARD_W_UNRESPONSIVE_CARD": hd = "The smart card is not responding to a reset."
Case "0x80100067": hc = "SCARD_W_UNPOWERED_CARD": hd = "Power has been removed from the smart card, so that further communication is not possible."
Case "0x80100068": hc = "SCARD_W_RESET_CARD": hd = "The smart card was reset."
Case "0x80100069": hc = "SCARD_W_REMOVED_CARD": hd = "The smart card has been removed, so further communication is not possible."
Case "0x8010006A": hc = "SCARD_W_SECURITY_VIOLATION": hd = "Access was denied because of a security violation."
Case "0x8010006B": hc = "SCARD_W_WRONG_CHV": hd = "The card cannot be accessed because the wrong PIN was presented."
Case "0x8010006C": hc = "SCARD_W_CHV_BLOCKED": hd = "The card cannot be accessed because the maximum number of PIN entry attempts has been reached."
Case "0x8010006D": hc = "SCARD_W_EOF": hd = "The end of the smart card file has been reached."
Case "0x8010006E": hc = "SCARD_W_CANCELLED_BY_USER": hd = "The action was canceled by the user."
Case "0x8010006F": hc = "SCARD_W_CARD_NOT_AUTHENTICATED": hd = "No PIN was presented to the smart card."
Case "0x80100070": hc = "SCARD_W_CACHE_ITEM_NOT_FOUND": hd = "The requested item could not be found in the cache."
Case "0x80100071": hc = "SCARD_W_CACHE_ITEM_STALE": hd = "The requested cache item is too old and was deleted from the cache."
Case "0x80100072": hc = "SCARD_W_CACHE_ITEM_TOO_BIG": hd = "The new cache item exceeds the maximum per-item size defined for the cache."
Case Else: hc = "UNKNOWN VALUE": hd = "Unknown value."
End Select
AuthDict.Add "hr", hreturn
AuthDict.Add "hc", hc
AuthDict.Add "hd", hd
End Function
Public Sub GetContext()
'https://learn.microsoft.com/en-us/windows/win32/secauthn/authentication-return-values?redirectedfrom=MSDN#smart_card_return_values
'https://learn.microsoft.com/en-us/windows/win32/debug/system-error-codes--0-499-?redirectedfrom=MSDN
'Credit: https://stackoverflow.com/questions/67199032/access-vba-and-smart-cards-whats-the-trick
'TODO: Finish SCardConnectA
Dim lReturn As Long
Dim RSVD1 As Long, RSVD2 As Long
Dim myContext, cardCon As LongPtr
Set AuthDict = New Scripting.Dictionary
Debug.Print "-----------------------------------------------------------------------------"
lReturn = SCardEstablishContext(SCARD_SCOPE_USER, RSVD1, RSVD2, myContext)
SCardAuthCode lReturn
Debug.Print "SCardEstablishContext:" & vbCrLf & _
" Return = " & AuthDict("hr") & vbCrLf & _
" Value = " & AuthDict("hc") & vbCrLf & _
" Description = " & AuthDict("hd") & vbCrLf
lReturn = SCardIsValidContext(myContext)
SCardAuthCode lReturn
Debug.Print "SCardIsValidContext:" & vbCrLf & _
" Return = " & AuthDict("hr") & vbCrLf & _
" Value = " & AuthDict("hc") & vbCrLf & _
" Description = " & AuthDict("hd") & vbCrLf
If lReturn <> 0 Then GoTo GetContextExit
GetContextExit:
Debug.Print "-----------------------------------------------------------------------------" & vbCrLf
SCardReleaseContext myContext
Exit Sub
ErrorHandler:
'TODO: handle the errors...
Resume GetContextExit
End Sub
I'm not sure what the point of
Public Type SCARDCONTEXT
CardContext1 As Long
ReaderName As String
End Type
is in the code I was following. It was causing me errors, so I just removed it. The code outputs
-----------------------------------------------------------------------------
SCardEstablishContext:
Return = 0x00000000
Value = SCARD_S_SUCCESS
Description = No error was encountered.
SCardIsValidContext:
Return = 0x00000000
Value = SCARD_S_SUCCESS
Description = No error was encountered.
-----------------------------------------------------------------------------
I'm not quite sure what I need to do next. It seems like now I need to identify the name of the CAC I want the data from (GetOpenCardNameA?), connect to it (SCardConnectA), and then use SCardTransmit to receive data from the card? I'm not sure if that's how these functions work.

Not 100% on sure if you can pull CAC information like that, but I do know that most Air Force CTK programs use TCMax which has a CAC function, and you can 100% set it up for armory use and generate excel status trackers and weapon assignments that way. I would suggest talk to your COMM about TCMax since it is program DOD uses anyway.

Related

Program reading CPU temperature incorrectly when put on new computer

I am trying to add a feature to an existing program that would display the current CPU core temperature using the Open Hardware Monitor. I have it working properly on my personal computer where it displays the temperature on a tool strip status label and refreshes on a timer. However, when I copy everything over to a new PC and test run the program the temperatures it returns are always coming back roughly 25 degrees higher than what the Monitor shows. If anyone has any ideas as to why it would read correctly on one computer but not another I would appreciate it as I'm stumped...
Here are the Monitor Temps and what my program is displaying on my PC both matched up.
Open Hardware Monitor temperatures
Temperature displayed in program
Now these are the temperatures displayed on the new PC that would be shipped out.
New PC Open Hardware Monitor
Program temperature display on New PC
This is the code I am currently using to get the temps.
Private Sub Timer3_Tick(sender As Object, e As EventArgs) Handles Timer3.Tick
Dim cp As New Computer()
cp.Open()
cp.HDDEnabled = True
cp.FanControllerEnabled = True
cp.RAMEnabled = True
cp.GPUEnabled = True
cp.MainboardEnabled = True
cp.CPUEnabled = True
Dim Info As String = ""
Timer3.Interval = 5000
For i As Integer = 0 To cp.Hardware.Length - 1
Dim hw = cp.Hardware(i)
Select Case hw.HardwareType
Case HardwareType.CPU
ToolStripStatusLabel5.Text = "CPU" & vbCrLf
For j = 0 To hw.Sensors.Length - 1
Dim sensor = hw.Sensors(j)
If cp.Hardware(i).Sensors(j).SensorType = SensorType.Temperature Then
ToolStripStatusLabel5.Text = sensor.Name & " - " & sensor.Value & vbCrLf
End If
Next
End Select
Next
End Sub
I didn't see the error in the code, here is an example of using OpenHardwaremonitor and WMI to get the CPU temperature, maybe you can try it.

Memory files get trashed by third party software

I have an collection of apps that rely on memory files. I create them with a persistent app, then 3 apps update the files with GPS, IMU and switch data, and 3 apps read the current status and generate commands to servo controllers. This has worked fine for years, but today the apps failed due to missing memory files when I started a third party c# camera control app.
I suspect the other app overwrites the memory area. Is there a way to protect these memory files.
I am in Visual Studio 2017, Win10/64 and .net 4.6.1
I have included the create and sample read and write code - all of which have worked for years. I did update the system to current .net 4.6.1, and without the 3rd party app the system runs for hours without error. The instant I start the c# app compiled app the memory files disappear. I do not have access to the source, and am hopeless with C#.
Not a clue now, one solution is to install a new CPU and run the 3rd partys app on a separate box. There is no communication between my apps and it.
I create with :
Dim LoopForever As Boolean = True
Dim AHRS_Memory_File_Name As String = "AHRSMemoryData"
Dim GPS_Memory_File_Name As String = "GPSMemoryData"
Dim Switch_Memory_File_Name As String = "SwitchMemoryData"
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As
System.EventArgs) Handles Button1.Click
Dim MMS = MemoryMappedFile.CreateNew(Switch_Memory_File_Name, 20,
MemoryMappedFileAccess.ReadWrite)
Dim GPS = MemoryMappedFile.CreateNew(GPS_Memory_File_Name, 200,
MemoryMappedFileAccess.ReadWrite)
Dim AHRS = MemoryMappedFile.CreateNew(AHRS_Memory_File_Name, 200,
MemoryMappedFileAccess.ReadWrite)
Do Until LoopForever = False
Thread.Sleep(10000)
Loop
End Sub
A sample Write is
Sub WriteGPS_To_Memory()
Dim GPS_MMF = MemoryMappedFile.OpenExisting(GPS_Memory_File_Name)
Dim Bytes As Byte()
' This is the format of the current gps memory message
outMessage = GPSSpeedIn & "," & GPSBearing & "," & GPSLongitude & ","
& GPSLatitude & "," & GarminMagDeviationText & "," & GPSMessageCount
& "," & GPSAltitude & ","
Bytes = StrToByteArray(outMessage)
Try
Using writer = GPS_MMF.CreateViewAccessor(0, Bytes.Length)
writer.WriteArray(Of Byte)(0, Bytes, 0, Bytes.Length)
' writer.Dispose()
End Using
Catch ex As Exception
MsgBox("mem write error = " & ex.ToString)
End Try
And a sample read is
Dim MMF = MemoryMappedFile.OpenExisting(MEMS_Memory_File_Name)
Using reader = MMF.CreateViewAccessor(0, 200,
MemoryMappedFileAccess.Read)
Dim NewByteString = New Byte(200) {}
reader.ReadArray(Of Byte)(0, NewByteString, 0,
NewByteString.Length)
InMessage = Convert.ToString(NewByteString)
teststring = ""
CycleCount = CycleCount + 1
teststring = BitConverter.ToString(NewByteString)
For i As Integer = 0 To NewByteString.Length - 1
AHRS_CommDataIn =
System.Text.Encoding.ASCII.GetString(NewByteString)
Next
End Using
MMF.Dispose()
Best outcome is to find a way to protect these files. I am in the US, the vendor is in Israel and not particularly responsive.
There is time pressure on this as my company uses this software to locate water bodies producing mosquitoes (hate those pests) which distribute West Nile Virus, Denge and Malaria. Today we scrubbed a 300 sq mi mission affecting about 500K persons.
The issue was apparently in the third party software - they issued a updated program the day we posted the issue to their support site - so we must not have been to only site with this issue

Detect when Removable USB Volume Drive Devices are Attached or Removed – VB.NET [duplicate]

This question already has an answer here:
Portable Device Detection
(1 answer)
Closed 5 years ago.
Below is some code I saw on a vb message board along time ago but I can’t remember where. It may have been vbforums.com. I made some code changes and then tested the code to have it throw a messagebox with the drive letter of the new usb device being attached or removed. It uses application subclassing to intercept the messages and checks if any are activated by a removable volume being Removed, Inserted, Attached, etc.. If it is then it will parse the volume drive letter of the device and throw a messagebox letting you know. USB devices like flash drives (Thumb Drives or Pen Drive’s as they are also called), external hard drives, etc. with a removable disk volume should be detected just fine. My testing recognized different usb volumes with no problems. You can use this code with VB.NET, Visual Basic 2008, VB 2010, 2013, etc. to check for both the arrival of usb volume devices and the removal. You can also make some changes to make it work for VB 6.0 as well. Visual Basic 6.0 will need an addiional API call or two for the subclassing portion.
Protected Overrides Sub WndProc(ByRef M As System.Windows.Forms.Message)
'
'These are the required subclassing codes for detecting device based removal and arrival.
'
If M.Msg = WM_DEVICECHANGE Then
Select Case M.WParam
'
'Check if a device was added.
Case DBT_DEVICEARRIVAL
Dim DevType As Integer = Runtime.InteropServices.Marshal.ReadInt32(M.LParam, 4)
If DevType = DBT_DEVTYP_VOLUME Then
Dim Vol As New DEV_BROADCAST_VOLUME
Vol = Runtime.InteropServices.Marshal.PtrToStructure(M.LParam, GetType(DEV_BROADCAST_VOLUME))
If Vol.Dbcv_Flags = 0 Then
For i As Integer = 0 To 20
If Math.Pow(2, i) = Vol.Dbcv_Unitmask Then
Dim Usb As String = Chr(65 + i) + ":\"
MsgBox("Looks like a USB device was plugged in!" & vbNewLine & vbNewLine & "The drive letter is: " & Usb.ToString)
Exit For
End If
Next
End If
End If
'
'Check if the message was for the removal of a device.
Case DBT_DEVICEREMOVECOMPLETE
Dim DevType As Integer = Runtime.InteropServices.Marshal.ReadInt32(M.LParam, 4)
If DevType = DBT_DEVTYP_VOLUME Then
Dim Vol As New DEV_BROADCAST_VOLUME
Vol = Runtime.InteropServices.Marshal.PtrToStructure(M.LParam, GetType(DEV_BROADCAST_VOLUME))
If Vol.Dbcv_Flags = 0 Then
For i As Integer = 0 To 20
If Math.Pow(2, i) = Vol.Dbcv_Unitmask Then
Dim Usb As String = Chr(65 + i) + ":\"
MsgBox("Looks like a volume device was removed!" & vbNewLine & vbNewLine & "The drive letter is: " & Usb.ToString)
Exit For
End If
Next
End If
End If
End Select
End If
MyBase.WndProc(M)
End Sub

Com Port doesn't work unless Hyperterminal Open and Closes Port First

So I am trying to connect to a piece of hardware. If I connect and disconnect with hyperterminal first. Then close the connection and the program. Everything works fine. If I don't I receive random characters back from the hardware. I use the same settings in hyperterminal as I do in the code.
baud=9600
parity=n
data=8
stop=1
Hardware flow controls "ON":
octs=on to=on dtr=on rts=hs
If I then disconnect the hardware and the serial port I will have the same problem again.
Is there anyway I can see how to comport is being configured after hyperterminal open and closes the port? I should note I am using a prolific serial to USB adapter.
Below is the code I use to open the com port.
Function OpenCom(PortNum As Integer, Baud As Long) As Long
Dim lpDCB As DCB
Dim ComTimeout As COMMTIMEOUTS
com$ = "COM" + Trim(Str(PortNum))
'open the communications port
hcomtemp& = CreateFile(com$, GENERIC_READ Or GENERIC_WRITE, 0, ByVal 0, OPEN_EXISTING, 0, ByVal 0)
'check for errors
If hcomtemp& < 0 Then
OpenCom = hcomtemp&
Exit Function
End If
r& = PurgeComm(hcomtemp&, 12) ' purge the comm RX and TX (RXCLEAR=0x08 and TXCLEAR=0x04)
' COMMAND LINE for "Hardware" flow control - mode com: baud=9600 parity=n data=8 stop=1 octs=on to=on dtr=on rts=hs
Build$ = "baud=" + Trim(str(Baud)) + " parity=N data=8 stop=1 octs=on to=on dtr=on rts=hs"
'build the data communications block
r& = BuildCommDCB(Build$, lpDCB)
'set the communications port's parameters with the DCB
r& = SetCommState(hcomtemp&, lpDCB)
ComTimeout.ReadIntervalTimeout = 100 'maximum time to wait between received bytes (milliseconds)
ComTimeout.ReadTotalTimeoutConstant = 1000 'maximum time to wait for receive data (milliseconds)
'set the timeouts
r& = SetCommTimeouts(hcomtemp&, ComTimeout)
'set the input buffer size to 4096 bytes and the output buffer size to 4096 bytes
r& = SetupComm(hcomtemp&, 4096, 4096)
'return the handle of the newly opened communications port
OpenCom = hcomtemp&
End Function
Please, try Advanced Serial Port Monitor -> Spy mode. http://www.aggsoft.com/serial-port-monitor.htm. It will show all actions that Hyperterminal does on the port. Then you can repeat these settings. It seems that the problem is related with the hardware flow control settings.
Below is the code I used to fix my problem. I only ever had to do it this way for one piece of equipment.
Function HandShakeBM5AS(ComPort As Integer) As Boolean
Dim Bm5ACom As Long
Dim x As Variant
Dim Path As String
comm$ = ComPort
Commands$ = "MODE COM" & comm$ & ": BAUD=9600 PARITY=N DATA=8 STOP=1 TO=ON XON=OFF ODSR=OFF OCTS=ON DTR=ON RTS=HS IDSR=OFF"
Call Shell("cmd.exe /S /C" & Commands$, vbNormalFocus)
'Shell (Commands$)
End Function
BuildCommDCB() fails if 'rts=hs' is included in the control string. This causes lpDCB to be not set correctly, and SetCommState is called with the wrong values.
You can set the RTS control flag in the lpDCB structure after calling BuildCommDCB. (I would include code but I'm not certain on the Basic syntax)

How to choose a specific modem when sending a fax?

I'm writing an application to send faxes trought FAXCOMEXLib. I used this code:
Dim objFaxServer As New FAXCOMEXLib.FaxServer
Dim objFaxDocument As New FAXCOMEXLib.FaxDocument
Dim JobID As Object
Try
objFaxServer.Connect(txtFaxServer.Text)
objFaxDocument.Body = Me.txtFile.Text
objFaxDocument.DocumentName = "My First Fax"
objFaxDocument.Recipients.Add(Me.txtNumber.Text, "")
objFaxDocument.AttachFaxToReceipt = True
objFaxDocument.Note = "Here is the info you requested"
objFaxDocument.Subject = Me.txtFaxID.Text
objFaxDocument.ReceiptAddress = "test#tin.it"
objFaxDocument.CoverPageType = FAXCOMEXLib.FAX_COVERPAGE_TYPE_ENUM.fcptNONE
objFaxDocument.Priority = FAXCOMEXLib.FAX_PRIORITY_TYPE_ENUM.fptNORMAL
objFaxDocument.ReceiptType = FAXCOMEXLib.FAX_RECEIPT_TYPE_ENUM.frtMAIL
objFaxDocument.ScheduleType = FAXCOMEXLib.FAX_SCHEDULE_TYPE_ENUM.fstNOW
JobID = objFaxDocument.ConnectedSubmit(objFaxServer)
objFaxServer.Disconnect()
'MessageBox.Show("The Job ID is :" & JobID(0), "Information")
Catch ex As Exception
MessageBox.Show(ex.ToString, "Error")
End Try
I have two modems (Modem1 or Modem2). When using this code sending a fax is carried out by the first available modem.
But I need to send faxes using Modem1 or Modem2 under my rules. How can I select a specific modem to send a fax?