API tools faq
paste
Advertisement
Guest User

Untitled

a guest
Nov 14th, 2019
157
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 62.03 KB | None | 0 0
raw download clone embed print report
  1. Private Sub tmrProximityReader_Timer()
  2. On Error Resume Next
  3. 'Go2018 #25
  4. 'If Me.MSCommProximityReader.InBufferCount > 0 And gblnMessageBoard_Active Then Call FctSetMessageBoard(False)
  5. If gblnBusyWithAnotherProcess Then Exit Sub
  6. On Error GoTo errorhandler
  7. Dim i As Integer
  8. '#Indien poging tot ingave met keyboard, de reader uitschakelen
  9. If (gstrCustomerName = "CHUTivoli") And gblnKeyBoard_FormOneForeGround = True Then
  10. Me.shapeProximity.Visible = False
  11. Me.shapeProximity.Refresh
  12. Me.MSCommProximityReader.InBufferCount = 0
  13. Exit Sub
  14. End If
  15. '
  16. Dim mTekst As String
  17. Dim mRetVal As String
  18. Dim gstrUserCardNumberSite As String
  19. gstrUserCardNumber = ""
  20. '
  21. If Not gintProximityReaderType = cProximityUSBOmnikey5x21 Then
  22. Call FctCheckCommPort_ProximityReader
  23. If gblnKeyboard_FormActive = True And gstrCustomerName = "AZDamiaan" Then
  24. gstrUserCardNumber = Me.MSCommProximityReader.input
  25. Exit Sub
  26. End If
  27. End If
  28. '
  29. Me.shapeProximity.Visible = Not Me.shapeProximity.Visible
  30. Me.shapeProximity.Refresh
  31. '#AZLokeren
  32. If gstrCustomerName = "AZLokeren" Then
  33. gstrUserCardNumber = Me.MSCommProximityReader.input
  34. If gstrUserCardNumber <> vbNullString Then
  35. gstrUserCardNumber = Replace(gstrUserCardNumber, Chr(13), "")
  36. gstrUserCardNumber = Replace(gstrUserCardNumber, Chr(10), "")
  37. gstrUserCardNumber = Replace(gstrUserCardNumber, Chr(3), "")
  38. gstrUserCardNumber = Replace(gstrUserCardNumber, Chr(2), "")
  39. '
  40. If Len(gstrUserCardNumber) = 7 Then
  41. gstrUserCardNumber = mID(gstrUserCardNumber, 5, 2) & mID(gstrUserCardNumber, 3, 2) & mID(gstrUserCardNumber, 1, 2) & "00"
  42. ElseIf Len(gstrUserCardNumber) = 8 Then
  43. gstrUserCardNumber = mID(gstrUserCardNumber, 6, 2) & mID(gstrUserCardNumber, 4, 2) & mID(gstrUserCardNumber, 2, 2) & "0" & mID(gstrUserCardNumber, 1, 1)
  44. ElseIf Len(gstrUserCardNumber) = 9 Then
  45. gstrUserCardNumber = mID(gstrUserCardNumber, 7, 2) & mID(gstrUserCardNumber, 5, 2) & mID(gstrUserCardNumber, 3, 2) & mID(gstrUserCardNumber, 1, 2)
  46. End If
  47. Me.lbl1.Caption = gstrUserCardNumber
  48. '
  49. If LDAP_CheckUser_MemberOf_NestedGroups(gstrLDAP_Applic_UserName, gstrLDAP_Applic_PassWord, gstrUserCardNumber) Then
  50. Me.MousePointer = vbDefault
  51. Call FctWriteToHistory_LogOn("LogOn", "Code = " & gstrUserCode & " F = " & gvarUserAccessCode, "")
  52. Call FctEnabled_MenuItemsAndButtons(gblnPilotActive)
  53. Exit Sub
  54. Else
  55. Me.MousePointer = vbDefault: Call FctNoAccess: Exit Sub
  56. End If
  57. Else
  58. Exit Sub
  59. End If
  60. End If
  61. '#XPerthis
  62. If gbytUserControlBy = cXPerthis Then 'AZStMariaHalle
  63. gstrUserCardNumber = Me.MSCommProximityReader.input
  64. If gstrUserCardNumber <> "" Then
  65. gstrUserCardNumber = Replace(gstrUserCardNumber, Chr(13), "")
  66. gstrUserCardNumber = Replace(gstrUserCardNumber, Chr(10), "")
  67. gstrUserCardNumber = Replace(gstrUserCardNumber, Chr(3), "")
  68. gstrUserCardNumber = Replace(gstrUserCardNumber, Chr(2), "")
  69. Me.lbl1.Caption = gstrUserCardNumber
  70. If FctXPerthis_AuthenticateBadge(gstrUserCardNumber) Then
  71. If Val(gvarUserAccessCode) < 61 Or Val(gvarUserAccessCode) > 68 Then
  72. Call FctNoAccess
  73. Else
  74. Call FctSetAllDatabaseConnections(True)
  75. Call FctWriteToHistory_LogOn("LogOn", mID("Code = " & gstrUserCardNumber & " F = " & gvarUserAccessCode & " " & gstrUserMiddelName & " " & gstrUserFirstName, 1, 100), "")
  76. gstrUserLanguage = gstrStartLanguage
  77. Call FctEnabled_MenuItemsAndButtons(False)
  78. End If
  79. Else
  80. Call FctNoAccess
  81. End If
  82. End If
  83. Exit Sub
  84. End If
  85. '#AZMonica + AISH_Seraing + Sp Ottignies + StLucasGent + StJozefIzegem
  86. '#Controle op ingelezen gebruikers in onze Gebruikerstabel
  87. If gstrCustomerName = "AZMonica" Or gstrCustomerName = "AISH_Seraing" Or gstrCustomerName = "SP_Ottignies" Or gstrCustomerName = "StLucasGent" Or gstrCustomerName = "StJozefIzegem" Then
  88. gstrUserCardNumber = Me.MSCommProximityReader.input
  89. If gstrUserCardNumber <> "" Then
  90. gstrUserCardNumber = Replace(gstrUserCardNumber, Chr(13), "")
  91. gstrUserCardNumber = Replace(gstrUserCardNumber, Chr(10), "")
  92. If gstrCustomerName <> "AZMonica" Then
  93. gstrUserCardNumber = Replace(gstrUserCardNumber, Chr(3), "")
  94. gstrUserCardNumber = Replace(gstrUserCardNumber, Chr(2), "")
  95. End If
  96. Me.lbl1.Caption = gstrUserCardNumber
  97. If Len(gstrUserCardNumber) >= 13 And gstrCustomerName = "AZMonica" Then
  98. gstrUserCardNumber = mID(gstrUserCardNumber, 6, 8)
  99. gstrUserCardNumber = Trim(str(FktHex2Dec(gstrUserCardNumber)))
  100. End If
  101. If Len(gstrUserCardNumber) >= 15 And gstrCustomerName = "SP_Ottignies" Then
  102. gstrUserCardNumber = mID(gstrUserCardNumber, 2, 12)
  103. End If
  104. If Left(gstrUserCardNumber, 1) = "*" And Right(gstrUserCardNumber, 1) = "#" And Len(gstrUserCardNumber) >= 20 And gstrCustomerName = "StLucasGent" Then
  105. gstrUserCardNumber = mID(gstrUserCardNumber, 6, 10)
  106. End If
  107. If Len(gstrUserCardNumber) >= 10 And gstrCustomerName = "StJozefIzegem" Then
  108. gstrUserCardNumber = mID(gstrUserCardNumber, 5, 5)
  109. gstrUserCardNumber = Trim(str(FktHex2Dec(gstrUserCardNumber)))
  110. End If
  111. Me.lbl2.Caption = gstrUserCardNumber
  112. Call FctSetAllDatabaseConnections(True)
  113. If gblnMultiDepartmentsDatabase And gblnUserControl_DepartmentSensitive Then
  114. tmpRecSet.Open "SELECT * FROM Gebruikers WHERE UnitID='" & gstrUnitID & "' AND GebruikerCode='" & gstrUserCardNumber & "'", gcnMyConnection, adOpenStatic, adLockReadOnly, adCmdText
  115. Else
  116. tmpRecSet.Open "SELECT * FROM Gebruikers WHERE GebruikerCode='" & gstrUserCardNumber & "'", gcnMyConnection, adOpenStatic, adLockReadOnly, adCmdText
  117. End If
  118. If Not (tmpRecSet.BOF And tmpRecSet.EOF) Then
  119. gvarUserAccessCode = tmpRecSet!GebruikerFunctie
  120. If Not IsNull(tmpRecSet!GebruikerNaam) Then gstrUserCode = tmpRecSet!GebruikerNaam
  121. End If
  122. tmpRecSet.Close
  123. Me.lbl2.Caption = Me.lbl2.Caption & " " & gvarUserAccessCode
  124. If Val(gvarUserAccessCode) < 61 Or Val(gvarUserAccessCode) > 68 Or gstrUserCode = "" Then 'Gebruikersnaam moet ingevuld zijn !!
  125. Call FctNoAccess
  126. gstrUserCardNumber = Me.MSCommProximityReader.input 'Reader leegmaken na de boodschap 'Geen Toegang'
  127. Exit Sub
  128. Else
  129. gstrUserLanguage = gstrStartLanguage
  130. Call FctEnabled_MenuItemsAndButtons(False)
  131. End If
  132. End If
  133. Exit Sub
  134. End If
  135. '#RenardHerstal
  136. If gstrCustomerName = "RenardHerstal" Then
  137. gstrUserCardNumber = Me.MSCommProximityReader.input
  138. If gstrUserCardNumber <> "" Then
  139. gstrUserCardNumber = Replace(gstrUserCardNumber, Chr(13), "")
  140. gstrUserCardNumber = Replace(gstrUserCardNumber, Chr(10), "")
  141. Me.lbl1.Caption = gstrUserCardNumber
  142. If Len(gstrUserCardNumber) > 2 Then
  143. gstrUserCardNumberSite = mID(gstrUserCardNumber, 8, 2)
  144. gstrUserCardNumber = mID(gstrUserCardNumber, 10, 4)
  145. gstrUserCardNumber = Trim(str(FktHex2Dec(gstrUserCardNumber)))
  146. gstrUserCardNumberSite = Trim(str(FktHex2Dec(gstrUserCardNumberSite)))
  147. End If
  148. Me.lbl2.Caption = gstrUserCardNumber
  149. Call FctSetAllDatabaseConnections(True)
  150. tmpRecSet.Open "SELECT * FROM Gebruikers WHERE GebruikerCode='" & gstrUserCardNumberSite & "-" & gstrUserCardNumber & "'", gcnMyConnection, adOpenStatic, adLockReadOnly, adCmdText
  151. If Not (tmpRecSet.BOF And tmpRecSet.EOF) Then
  152. gvarUserAccessCode = tmpRecSet!GebruikerFunctie
  153. glngUserRecordID = tmpRecSet!RecordID
  154. If Not IsNull(tmpRecSet!GebruikerNaam) Then gstrUserCode = tmpRecSet!GebruikerNaam
  155. End If
  156. tmpRecSet.Close
  157. Me.lbl2.Caption = Me.lbl2.Caption & " " & gvarUserAccessCode
  158. If Val(gvarUserAccessCode) < 61 Or Val(gvarUserAccessCode) > 67 Or gstrUserCode = "" Then 'Gebruikersnaam moet ingevuld zijn !!
  159. Call FctNoAccess
  160. gstrUserCardNumber = Me.MSCommProximityReader.input 'Reader leegmaken na de boodschap 'Geen Toegang'
  161. Exit Sub
  162. Else
  163. gstrUserLanguage = gstrStartLanguage
  164. Call FctWriteToHistory_LogOn("LogOn", "Code = " & gstrUserCode & " F = " & gvarUserAccessCode, "")
  165. Call FctEnabled_MenuItemsAndButtons(False)
  166. End If
  167. End If
  168. Exit Sub
  169. End If
  170. '#CHUTivoli
  171. If gstrCustomerName = "CHUTivoli" Then
  172. gstrUserCardNumber = Me.MSCommProximityReader.input
  173. gstrUserCardNumber = Replace(gstrUserCardNumber, Chr(13), "")
  174. gstrUserCardNumber = Replace(gstrUserCardNumber, Chr(10), "")
  175. Me.lbl1.Caption = gstrUserCardNumber
  176. If Len(gstrUserCardNumber) >= 13 Then gstrUserCardNumber = FctTranslateTivoliBadge(gstrUserCardNumber)
  177. Me.lbl2.Caption = gstrUserCardNumber
  178. If gstrUserCardNumber <> "" Then
  179. Call FctSetAllDatabaseConnections(True)
  180. If LDAP_CheckUser_ViaExternalExe(gstrUserCardNumber, "?", "?") = True Then
  181. Call FctWriteToHistory_LogOn("LogOn", "Code = " & gstrUserCode & " F = " & gvarUserAccessCode, "")
  182. Call FctEnabled_MenuItemsAndButtons(False)
  183. glngUserRecordID = FctGetUser_RecordID(gstrUserCardNumber)
  184. Else
  185. Call FctNoAccess
  186. gstrUserCardNumber = Me.MSCommProximityReader.input 'Reader leegmaken na de boodschap 'Geen Toegang'
  187. Exit Sub
  188. End If
  189. End If
  190. Exit Sub
  191. End If
  192. '#Moeskroen
  193. If gstrCustomerName = "Moeskroen" Then
  194. Dim mUserID As Long: mUserID = 0
  195. gstrUserCardNumber = Me.MSCommProximityReader.input
  196. If Len(gstrUserCardNumber) >= 5 Then
  197. gstrUserCardNumber = Right(gstrUserCardNumber, 6)
  198. Else
  199. Exit Sub
  200. End If
  201. gstrUserCardNumber = Replace(gstrUserCardNumber, " ", "")
  202. '
  203. gconSiPassUserDatabase_Connection.ConnectionString = gstrSiPassUserDatabase_ConnectionString
  204. gconSiPassUserDatabase_Connection.Open
  205. If gconSiPassUserDatabase_Connection.State = adStateOpen Then
  206. Dim tmpRecSetUser As New ADODB.Recordset
  207. gstrSQL = "SELECT m.id,m.nachname,m.vorname " _
  208. & "FROM ecbern.mitarbeiter m " _
  209. & "INNER JOIN ecbern.mitarbeiter_kategoriedetail g ON m.ID = g.MITARBEITER_ID " _
  210. & "INNER JOIN ecbern.kategorie k ON k.knoten_id = g.knoten_id " _
  211. & "INNER JOIN ecbern.kategorie_typ t ON t.kategorietyp_id = k.kategorietyp_id " _
  212. & "WHERE t.kategorietyp_id in (31,34,35,36,37,38,39,40,41,42,43,44,45,46,47,62,82,86,210,55,90,210,250,171) " _
  213. & "AND m.badge = " & Val(gstrUserCardNumber)
  214. tmpRecSetUser.Open gstrSQL, gconSiPassUserDatabase_Connection, adOpenStatic, adLockReadOnly, adCmdText
  215. If Not (tmpRecSetUser.BOF And tmpRecSetUser.EOF) Then
  216. If Not IsNull(tmpRecSetUser!nachname) Then gstrUserCode = tmpRecSetUser!nachname
  217. If Not IsNull(tmpRecSetUser!id) Then mUserID = tmpRecSetUser!id
  218. gstrUserLanguage = cDutch
  219. End If
  220. End If
  221. tmpRecSetUser.Close
  222. gconSiPassUserDatabase_Connection.Close
  223. '
  224. If mUserID = 0 Then
  225. Call FctNoAccess: Exit Sub
  226. Else
  227. 'Extra bij Infohos controleren op een hogere functie
  228. If gbytControlePWDVersion = 1 Then
  229. Dim Ctrl2 As New ControlePwd.ControleLogin
  230. gvarUserAccessCode = Ctrl2.ControleLogin(LCase(mUserID), "")
  231. Else
  232. If gblnUserControl_DepartmentSensitive Then
  233. gvarUserAccessCode = FctGetIHCPharmacySecurity(SecType.UserCode_CupBoard, str(mUserID), "", gstrCustomerCabinetID)
  234. Else
  235. gvarUserAccessCode = FctGetIHCPharmacySecurity(SecType.UserCode, str(mUserID), "", "")
  236. End If
  237. End If
  238. If IsNull(gvarUserAccessCode) Then gvarUserAccessCode = 61
  239. If Val(gvarUserAccessCode) < 61 Or Val(gvarUserAccessCode) > 68 Then gvarUserAccessCode = 61
  240. DoEvents: Me.MousePointer = vbDefault
  241. Call FctSetAllDatabaseConnections(True)
  242. gstrUserLanguage = gstrStartLanguage
  243. Call FctWriteToHistory_LogOn("LogOn", "Code = " & gstrUserCode & " F = " & gvarUserAccessCode, "")
  244. Call FctEnabled_MenuItemsAndButtons(False)
  245. End If
  246. Exit Sub
  247. End If
  248. '#AZGroeninge
  249. If gstrCustomerName = "AZGroeninge" Then
  250. gstrUserCardNumber = Me.MSCommProximityReader.input
  251. If Len(gstrUserCardNumber) >= 13 Then
  252. gstrUserCardNumber = mID(gstrUserCardNumber, 6, 7) 'Opsplitsen
  253. gstrUserCardNumber = FctConvert_HexToBin(gstrUserCardNumber) 'Omzetten van Hex 2 Bin
  254. gstrUserCardNumber = mID(gstrUserCardNumber, 2, 24) 'Start en Parity weglaten
  255. gstrUserCardNumber = FctConvert_BinToDec(mID(gstrUserCardNumber, 9, 16)) 'Badgenummer gedeelte bin omzetten naar Dec
  256. Else
  257. Exit Sub
  258. End If
  259. '
  260. If gstrUserCardNumber <> "" Then
  261. Call FctSetAllDatabaseConnections(True)
  262. If gblnWorkingWithLocalData_Active Then
  263. gvarUserAccessCode = FctGetUser_CredentialsFromHistory(gstrUserCardNumber)
  264. If gvarUserAccessCode = 0 Then Call FctNoAccess: Exit Sub
  265. Call FctWriteToHistory_LogOn("LogOn", "Code = " & gstrUserCode & " F = " & gvarUserAccessCode, "")
  266. Call FctEnabled_MenuItemsAndButtons(False)
  267. Exit Sub
  268. End If
  269. '
  270. If gstrComputerName = gstrDevelopmentPCName Then
  271. gstrSQL = "SELECT value, user_loginname FROM tab_user u, tab_user_right r " _
  272. & "WHERE u.UserID = r.UserID AND UPPER(r.application)=UPPER('" & gstrCustomerPm1 & "') AND LOWER(param)=LOWER('access') " _
  273. & "AND u.BadgeNr=" & Val(gstrUserCardNumber) & " AND (u.User_Inactive >= GETDATE() OR u.User_Inactive IS NULL)"
  274. Else
  275. gstrSQL = "SELECT value, user_loginname FROM tab_user u, tab_user_right r " _
  276. & "WHERE u.UserID = r.UserID AND UPPER(r.application)=UPPER('" & gstrCustomerPm1 & "') AND LOWER(param)=LOWER('access') " _
  277. & "AND u.BadgeNr=" & Val(gstrUserCardNumber) & " AND (u.User_Inactive >= SYSDATE OR u.User_Inactive IS NULL)"
  278. End If
  279. tmpRecSet.Open gstrSQL, gcnUserConnection, adOpenStatic, adLockReadOnly, adCmdText
  280. If (tmpRecSet.EOF And tmpRecSet.BOF) Then
  281. gvarUserAccessCode = 0
  282. tmpRecSet.Close
  283. Call FctNoAccess: Exit Sub
  284. Else
  285. gstrUserCode = Trim(tmpRecSet.Fields("user_loginname").Value)
  286. gvarUserAccessCode = Trim(tmpRecSet.Fields("value"))
  287. tmpRecSet.Close
  288. gstrUserLanguage = cDutch
  289. End If
  290. Call FctWriteToHistory_LogOn("LogOn", "Code = " & gstrUserCode & " F = " & gvarUserAccessCode, gstrUserCardNumber)
  291. If Val(gvarUserAccessCode) < 61 Or Val(gvarUserAccessCode) > 67 Then
  292. Call FctNoAccess: Exit Sub
  293. Else
  294. Call FctEnabled_MenuItemsAndButtons(False)
  295. End If
  296. End If
  297. Exit Sub
  298. End If
  299. '#OLVZAalst + AZDelta + StElisabethZottegem + UZGent + Lesperance + Emmaus
  300. If gintProximityReaderType = cProximityHID_ProxPro Then
  301. gstrUserCardNumber = Me.MSCommProximityReader.input
  302. If gstrUserCardNumber <> "" Then
  303. Call fctWriteProximityLog("tmrProximityReader_Timer", "First read: " & gstrUserCardNumber)
  304. Sleep (100)
  305. gstrUserCardNumber = gstrUserCardNumber & Me.MSCommProximityReader.input
  306. Call fctWriteProximityLog("tmrProximityReader_Timer", "Second read: " & gstrUserCardNumber)
  307. Else
  308. Exit Sub
  309. End If
  310.  
  311. If gstrCustomerName = "Lesperance" Then
  312. If Len(gstrUserCardNumber) >= 13 Then gstrUserCardNumber = mID(gstrUserCardNumber, 2, 12)
  313. Call fctWriteProximityLog("tmrProximityReader_Timer", "Esperance modification: " & gstrUserCardNumber)
  314. End If
  315. gstrUserCardNumber = FctFilterProximityInputs(gstrUserCardNumber)
  316. If gstrCustomerName = "AZDelta" Then
  317. If gstrUserCardNumber <> vbNullString Then
  318. Dim mAnswer As String
  319. For i = Len(gstrUserCardNumber) To 1 Step -1
  320. mAnswer = mAnswer & Format(Hex(Asc(mID(gstrUserCardNumber, i, 1))), "00")
  321. Next i
  322. Me.lbl1.Caption = mAnswer
  323. mAnswer = FktHex2Dec(mAnswer)
  324. Me.lbl2.Caption = mAnswer
  325. If Len(mAnswer) > 8 Then gstrUserCardNumber = Right(mAnswer, 8) Else gstrUserCardNumber = mAnswer
  326. Call fctWriteProximityLog("tmrProximityReader_Timer", "AZ Delta Modification: " & gstrUserCardNumber)
  327. End If
  328. End If
  329. '
  330. Me.lbl1.Caption = gstrUserCardNumber
  331. Call FctSetAllDatabaseConnections(True)
  332. If gbytUserControlBy = cInfohos Then
  333. Call fctWriteProximityLog("tmrProximityReader_Timer", "Infohos request start")
  334. If gbytControlePWDVersion = 1 Then
  335. Dim ctrl As New ControlePwd.ControleLogin
  336. gvarUserAccessCode = ctrl.ControleLogin(LCase(gstrUserCardNumber), "")
  337. Else
  338. If gblnUserControl_DepartmentSensitive Then
  339. gvarUserAccessCode = FctGetIHCPharmacySecurity(SecType.UserCode_CupBoard, gstrUserCardNumber, "", gstrCustomerCabinetID)
  340. Else
  341. gvarUserAccessCode = FctGetIHCPharmacySecurity(SecType.UserCode, gstrUserCardNumber, "", "")
  342. End If
  343. End If
  344. Call fctWriteProximityLog("tmrProximityReader_Timer", "Infohos request end")
  345.  
  346. 'TBU Ticket 3752
  347. If (gstrCustomerName = "AZDelta") Then
  348. gvarUserAccessCode = fktAzDeltaGetLevelUser(gstrUserCode)
  349. End If
  350.  
  351. If Val(gvarUserAccessCode) < 61 Or Val(gvarUserAccessCode) > 68 Then
  352. mTekst = "Card:" & gstrUserCardNumber & vbLf & "Web:" & gstrUserCardNumber & vbLf
  353. Call FctNoAccess: Exit Sub
  354. Else
  355. gstrUserLanguage = gstrStartLanguage
  356. gstrUserCode = gstrUserCardNumber
  357. Call FctEnabled_MenuItemsAndButtons(False)
  358. End If
  359. End If
  360. If gbytUserControlBy = cPharmalogic Then
  361.  
  362. tmpRecSet.Open "SELECT * FROM Gebruikers WHERE GebruikerCode='" & gstrUserCardNumber & "'", gcnMyConnection, adOpenStatic, adLockReadOnly, adCmdText
  363. If Not (tmpRecSet.BOF And tmpRecSet.EOF) Then
  364. gvarUserAccessCode = tmpRecSet!GebruikerFunctie
  365. If Not IsNull(tmpRecSet!GebruikerNaam) Then gstrUserCode = tmpRecSet!GebruikerNaam
  366. End If
  367. tmpRecSet.Close
  368.  
  369. 'TBU Ticket 3752
  370. If (gstrCustomerName = "AZDelta") Then
  371. gvarUserAccessCode = fktAzDeltaGetLevelUser(gstrUserCardNumber)
  372. End If
  373.  
  374. If Val(gvarUserAccessCode) < 61 Or Val(gvarUserAccessCode) > 67 Or gstrUserCode = "" Then 'Gebruikersnaam moet ingevuld zijn !!
  375. Call FctNoAccess: Exit Sub
  376. Else
  377. gstrUserLanguage = gstrStartLanguage
  378. Call FctEnabled_MenuItemsAndButtons(False)
  379. End If
  380. End If
  381. If gbytUserControlBy = cLDAP Then
  382. Select Case gstrCustomerName
  383. Case "UZGent"
  384. Me.lbl1.Caption = gstrUserCardNumber
  385. retval = ExecCmd(App.Path & "\ADLdap.exe Badge=" & gstrUserCardNumber)
  386. Select Case retval
  387. Case 0, 2
  388. frmMsgBoxInfo.lblMelding.Caption = GetTxt("OnbekendeMagneetKaart") & " (AD)"
  389. frmMsgBoxInfo.Show vbModal, Me
  390. Exit Sub
  391. Case 1
  392. gstrUserCode = FctIniFile_ReadValue("LDAP", "tmpLDAPUser", "")
  393. Me.lbl1.Caption = gstrUserCode
  394. If gstrUserCode = "" Then
  395. frmMsgBoxInfo.lblMelding.Caption = GetTxt("OnbekendeMagneetKaart") & " (AD)"
  396. frmMsgBoxInfo.Show vbModal, Me
  397. Exit Sub
  398. End If
  399. tmpRecSet.Open "SELECT * FROM [vanas].[DispenserUsers] inner join [vanas].[DispenserUserUnits] on [DispenserUsers].RecordId = [DispenserUserId] inner join [vanas].[Units] on [DispenserUserUnits].[UnitId] = [Units].RecordId WHERE UserName = '" & gstrUserCode & "' AND [Units].UnitID = '" & gstrUnitID & "'", gcnPilotConnection, adOpenStatic, adLockReadOnly, adCmdText
  400. If Not (tmpRecSet.BOF And tmpRecSet.EOF) Then
  401. tmpRecSet.Close
  402. tmpRecSet.Open "SELECT * FROM Gebruikers WHERE GebruikerCode='" & gstrUserCode & "' AND HasAccess=1", gcnMyConnection, adOpenStatic, adLockReadOnly, adCmdText
  403. End If
  404. '
  405. If Not (tmpRecSet.BOF And tmpRecSet.EOF) Then
  406. gvarUserAccessCode = tmpRecSet!GebruikersGroepKeysRecordID
  407. Else
  408. tmpRecSet.Close
  409. frmMsgBoxInfo.lblMelding.Caption = GetTxt("OnbekendeGebruiker")
  410. frmMsgBoxInfo.Show vbModal, Me
  411. Exit Sub
  412. End If
  413. '
  414. tmpRecSet.Close
  415. gstrUserLanguage = gstrStartLanguage
  416. Call FctWriteToHistory_LogOn("LogOn", "Code = " & gstrUserCode & " F = " & gvarUserAccessCode, "")
  417. Call FctEnabled_MenuItemsAndButtons(True)
  418. Me.lbl2.Caption = gstrUserCode & " " & gstrUserGroup
  419. Call FctUpdatePilotUserTables
  420. End Select
  421. Case "Emmaus"
  422. Me.lbl1.Caption = gstrUserCardNumber
  423. If LDAP_CheckUser_MemberOf_NestedGroups(gstrLDAP_Applic_UserName, gstrLDAP_Applic_PassWord, gstrUserCardNumber) Then
  424. Me.MousePointer = vbDefault
  425. If gblnDoubleCheckUser_AuthenticateWithBadge Then
  426. If gvarUserAccessCode_DoubleCheck <> "62" And gvarUserAccessCode_DoubleCheck <> "63" Then
  427. gblnDoubleCheckUser_AuthenticationSuccesfull = True
  428. Call FctWriteToHistory_LogOn("Auth. Success", "Code = " & gstrUserCode_DoubleCheck & " F = " & gvarUserAccessCode_DoubleCheck, "")
  429. Else
  430. gblnDoubleCheckUser_AuthenticationSuccesfull = False
  431. gblnDoubleCheckUser_AuthenticationWithBadgeFailed = True
  432. Call FctWriteToHistory_LogOn("Auth. Failed", "Code = " & gstrUserCode_DoubleCheck & " F = " & gvarUserAccessCode_DoubleCheck, "")
  433. End If
  434. Else
  435. Call FctWriteToHistory_LogOn("LogOn", "Code = " & gstrUserCode & " F = " & gvarUserAccessCode, "")
  436. Call FctEnabled_MenuItemsAndButtons(gblnPilotActive)
  437. End If
  438. Else
  439. Me.MousePointer = vbDefault: Call FctNoAccess: Exit Sub
  440. End If
  441. End Select
  442. End If
  443. Call fctWriteProximityLog("tmrProximityReader_Timer", "----------------------------------------")
  444. Exit Sub
  445. End If
  446. '#StRembert & AZDamiaan
  447. If gintProximityReaderType = cProximityHID_ProxProWebService Then
  448. gstrUserCardNumber = Me.MSCommProximityReader.input
  449. If gstrUserCardNumber <> "" Then
  450. Call FctSetAllDatabaseConnections(True)
  451. 'CR wegfilteren
  452. If Not Right(gstrUserCardNumber, 1) = Chr(10) Then Exit Sub 'Laatste karakter geen Chr(10) = geen volledig bericht
  453. gstrUserCardNumber = Replace(gstrUserCardNumber, Chr(10), "")
  454. gstrUserCardNumber = Replace(gstrUserCardNumber, Chr(13), "")
  455. If gstrCustomerName = "AZDamiaan" Then
  456. 'Eerst paswoord nog opvragen
  457. gstrUserCardNumber = Replace(gstrUserCardNumber, "N", "") 'Eerste N wegfilteren
  458. gstrUserCardNumber = Trim(Val(gstrUserCardNumber))
  459. 'Password nog opvragen
  460. If gstrCustomerName = "AZDamiaan" Then gblnKeyboard_Input(4) = True
  461. Call FctPreparationKeyBoard
  462. frmKeyBoard.Show vbModal, Me
  463. If frmKeyBoard.txtKeyBoard.Text <> "" Then
  464. gstrUserCode = frmKeyBoard.txtKeyBoard.Text
  465. gvarUserAccessCode = ""
  466. mRetVal = FktGetInfoHosIDViaWebService2(gstrUserCardNumber, gstrUserCode)
  467. If Val(gvarUserAccessCode) < 61 Or Val(gvarUserAccessCode) > 68 Then
  468. Call FctNoAccess: Exit Sub
  469. Else
  470. gstrUserLanguage = gstrStartLanguage
  471. Call FctEnabled_MenuItemsAndButtons(False)
  472. End If
  473. Else
  474. Call FctSetAllDatabaseConnections(False)
  475. Exit Sub
  476. End If
  477. Else 'St Rembert
  478. 'Procedure:Gebruiker logt aan met Badge
  479. 'Webservice geeft gebruikersnaam en SecurityLevel terug
  480. Dim mUser As String
  481. mUser = FktGetInfoHosIDViaWebService(gstrUserCardNumber)
  482. '2 Volgende regels activeren en uittesten indien St Rembert overschakeld naar Universeel programma
  483. 'If gbytControlePWDVersion = 1 Then
  484. ' Dim Ctrl2 As New ControlePwd.ControleLogin
  485. ' gvarUserAccessCode = Ctrl2.ControleLogin(LCase(mUser), "")
  486. 'Else
  487. ' gvarUserAccessCode = FctGetIHCPharmacySecurity(SecType.UserCode, mUser, "", "")
  488. 'End If
  489. 'Indien bij Infohos gekend is het niveau van Infohos van toepassing, anders telt de webservice toegangsniveau.
  490. If Val(gvarUserAccessCode) < 61 Or Val(gvarUserAccessCode) > 68 Then
  491. gvarUserAccessCode = mstrSecurityLevel 'Deze is opgehaald met FktGetInfoHosIDViaWebService
  492. End If
  493. '
  494. If Val(gvarUserAccessCode) < 61 Or Val(gvarUserAccessCode) > 68 Then
  495. mTekst = "Card: " & gstrUserCardNumber & vbLf & "Web: " & mUser & vbLf & "Level: " & gvarUserAccessCode
  496. Call FctSetAllDatabaseConnections(False)
  497. MsgBox mTekst & GetTxt("UHebtGeenToegangsRechten"), vbInformation, gstrMsgBoxTitle
  498. Exit Sub
  499. Else
  500. gstrUserLanguage = gstrStartLanguage
  501. Call FctEnabled_MenuItemsAndButtons(False)
  502. End If
  503. End If
  504. End If
  505. End If
  506. '#AZDamiaan USB
  507. If gintProximityReaderType = cProximityUSBOmnikey5x21 And gstrCustomerName = "AZDamiaan" Then
  508. gstrUserCardNumber = FctReadOmnikey5x21CL
  509. Me.lbl1.Caption = gstrUserCardNumber
  510. If gstrUserCardNumber <> "" Then
  511. If mID(gstrUserCardNumber, 1, 5) = "Error" Then Exit Sub
  512. gstrUserCardNumber = Replace(LTrim(Replace(gstrUserCardNumber, "0", " ")), " ", "0")
  513. Unload frmKeyBoard: mblnLogOnExit = True
  514. Call FctSetAllDatabaseConnections(True)
  515. 'Eerst paswoord nog opvragen
  516. gblnKeyboard_Input(4) = True
  517. Call FctPreparationKeyBoard
  518. frmKeyBoard.Show vbModal, Me
  519. If frmKeyBoard.txtKeyBoard.Text <> "" Then
  520. gstrUserCode = frmKeyBoard.txtKeyBoard.Text
  521. gvarUserAccessCode = ""
  522. mRetVal = FktGetInfoHosIDViaWebService2(gstrUserCardNumber, gstrUserCode)
  523. If Val(gvarUserAccessCode) < 61 Or Val(gvarUserAccessCode) > 68 Then
  524. Call FctNoAccess: Exit Sub
  525. Else
  526. gstrUserLanguage = gstrStartLanguage
  527. Call FctWriteToHistory_LogOn("LogOn", "Code = " & gstrUserCode & " F = " & gvarUserAccessCode, "")
  528. Call FctEnabled_MenuItemsAndButtons(False)
  529. End If
  530. Else
  531. Call FctSetAllDatabaseConnections(False)
  532. Exit Sub
  533. End If
  534. End If
  535. End If
  536. '#HHMol
  537. If gintProximityReaderType = cProximityUSBOmnikey5x21 And gstrCustomerName = "HHMol" Then
  538. gstrUserCardNumber = FctReadOmnikey5x21CL
  539. Me.lbl1.Caption = gstrUserCardNumber: Me.lbl1.Refresh
  540. If gstrUserCardNumber <> "" Then
  541. If mID(gstrUserCardNumber, 1, 5) = "Error" Then
  542. If Not gstrComputerName = gstrDevelopmentPCName Then Sleep 1000 '#Na een card ingelezen te hebben, minstens 1 sec wachten om opnieuw de reader te gebruiken Device idle ?
  543. Exit Sub
  544. End If
  545. Me.MousePointer = vbHourglass
  546. gstrUserCardNumber = Val(gstrUserCardNumber) 'Voorloopnullen verwijderen
  547. If LDAP_CheckUser_Attribute(gstrUserCardNumber) = False Then
  548. Me.MousePointer = vbDefault
  549. Call FctNoAccess: Exit Sub
  550. End If
  551. If LDAP_CheckUser_MemberOf_NestedGroups(gstrUserCode, "") Then
  552. Call FctSetAllDatabaseConnections(True)
  553. Me.MousePointer = vbDefault
  554. Call FctWriteToHistory_LogOn("LogOn", "Code = " & gstrUserCode & " F = " & gvarUserAccessCode, "")
  555. Call FctEnabled_MenuItemsAndButtons(gblnPilotActive)
  556. Else
  557. Me.MousePointer = vbDefault
  558. Call FctNoAccess: Exit Sub
  559. End If
  560. End If
  561. End If
  562. 'StElisabethHerentals
  563. Dim dblCardnumber As Double
  564. If gstrCustomerName = "StElisabethHerentals" Then
  565. gstrUserCardNumber = Me.MSCommProximityReader.input
  566. 'If gstrUserCardNumber <> "" Then MsgBox ("iets")
  567. If Len(gstrUserCardNumber) > 2 Then
  568. 'MsgBox (gstrUserCardNumber)
  569. 'MsgBox (gstrUserCardNumber)
  570. 'Me.tmrMifare.Enabled = False
  571. 'Debug.Print gstrUserCardNumber
  572. Me.lbl1.Caption = gstrUserCardNumber: Me.lbl1.Refresh
  573. If gstrUserCardNumber <> vbNullString Then
  574. Do Until Asc(Right(gstrUserCardNumber, 1)) <> 13 And Asc(Right(gstrUserCardNumber, 1)) <> 10
  575. gstrUserCardNumber = mID(gstrUserCardNumber, 1, Len(gstrUserCardNumber) - 1)
  576. Loop
  577. If mID(gstrUserCardNumber, 1, 5) = "Error" Then
  578. If Not gstrComputerName = gstrDevelopmentPCName Then Sleep 1000 '#Na een card ingelezen te hebben, minstens 1 sec wachten om opnieuw de reader te gebruiken Device idle ?
  579. Exit Sub
  580. End If
  581. 'Debug.Print gstrUserCardNumber
  582. 'MsgBox (gstrUserCardNumber)
  583. Me.lbl1.Caption = gstrUserCardNumber: Me.lbl1.Refresh
  584. gstrUserCardNumber = mID(gstrUserCardNumber, 12, 2) & mID(gstrUserCardNumber, 10, 2) & mID(gstrUserCardNumber, 8, 2) & mID(gstrUserCardNumber, 6, 2)
  585. 'MsgBox (gstrUserCardNumber)
  586. dblCardnumber = HexToDec(gstrUserCardNumber)
  587. gstrUserCardNumber = CStr(dblCardnumber)
  588. 'MsgBox (gstrUserCardNumber)
  589. 'If mID(CStr(gstrUserCardNumber), 1, 1) = "-" Then gstrUserCardNumber = mID(CStr(gstrUserCardNumber), 2, Len(CStr(gstrUserCardNumber)))
  590. 'MsgBox (gstrUserCardNumber)
  591. Me.MousePointer = vbHourglass
  592. gstrUserCardNumber = Val(gstrUserCardNumber) 'Voorloopnullen verwijderen
  593. If LDAP_CheckUser_Attribute(gstrUserCardNumber) = False Then
  594. Me.MousePointer = vbDefault
  595. Call FctNoAccess: Exit Sub
  596. End If
  597. If LDAP_CheckUser_MemberOf_NestedGroups(gstrUserCode, "") Then
  598. Call FctSetAllDatabaseConnections(True)
  599. Me.MousePointer = vbDefault
  600. Call FctWriteToHistory_LogOn("LogOn", "Code = " & gstrUserCode & " F = " & gvarUserAccessCode, "")
  601. Call FctEnabled_MenuItemsAndButtons(gblnPilotActive)
  602. Else
  603. Me.MousePointer = vbDefault
  604. Call FctNoAccess: Exit Sub
  605. End If
  606. End If
  607. End If
  608. End If
  609.  
  610. 'gstrUserCardNumber = Me.MSCommProximityReader.input
  611. 'Me.lbl1.Caption = gstrUserCardNumber: Me.lbl1.Refresh
  612. 'If gstrUserCardNumber <> "" Then
  613. ' If mID(gstrUserCardNumber, 1, 5) = "Error" Then
  614. ' If Not gstrComputerName = gstrDevelopmentPCName Then Sleep 1000 '#Na een card ingelezen te hebben, minstens 1 sec wachten om opnieuw de reader te gebruiken Device idle ?
  615. ' Exit Sub
  616. ' End If
  617. ' Me.MousePointer = vbHourglass
  618. ' gstrUserCardNumber = Val(gstrUserCardNumber) 'Voorloopnullen verwijderen
  619. ' If LDAP_CheckUser_Attribute(gstrUserCardNumber) = False Then
  620. ' Me.MousePointer = vbDefault
  621. ' Call FctNoAccess: Exit Sub
  622. ' End If
  623. ' If LDAP_CheckUser_MemberOf_NestedGroups(gstrUserCode, "") Then
  624. ' Call FctSetAllDatabaseConnections(True)
  625. ' Me.MousePointer = vbDefault
  626. ' Call FctWriteToHistory_LogOn("LogOn", "Code = " & gstrUserCode & " F = " & gvarUserAccessCode, "")
  627. ' Call FctEnabled_MenuItemsAndButtons(gblnPilotActive)
  628. ' Else
  629. ' Me.MousePointer = vbDefault
  630. ' Call FctNoAccess: Exit Sub
  631. ' End If
  632. 'End If
  633. 'End If
  634. '#MaasEnKempen
  635. If gstrCustomerName = "MaasEnKempen" Then
  636. 'gstrUserCardNumber = Me.MSCommProximityReader.input
  637. 'Me.lbl1.Caption = gstrUserCardNumber: Me.lbl1.Refresh
  638. 'If gstrUserCardNumber <> "" Then
  639. ' If mID(gstrUserCardNumber, 1, 5) = "Error" Then
  640. ' If Not gstrComputerName = gstrDevelopmentPCName Then Sleep 1000 '#Na een card ingelezen te hebben, minstens 1 sec wachten om opnieuw de reader te gebruiken Device idle ?
  641. ' Exit Sub
  642. ' End If
  643. ' Me.MousePointer = vbHourglass
  644. ' gstrUserCardNumber = Val(gstrUserCardNumber) 'Voorloopnullen verwijderen
  645. ' If LDAP_CheckUser_Attribute(gstrUserCardNumber) = False Then
  646. ' Me.MousePointer = vbDefault
  647. ' Call FctNoAccess: Exit Sub
  648. ' End If
  649. ' If LDAP_CheckUser_MemberOf_NestedGroups(gstrUserCode, "") Then
  650. ' Call FctSetAllDatabaseConnections(True)
  651. ' Me.MousePointer = vbDefault
  652. ' Call FctWriteToHistory_LogOn("LogOn", "Code = " & gstrUserCode & " F = " & gvarUserAccessCode, "")
  653. ' Call FctEnabled_MenuItemsAndButtons(gblnPilotActive)
  654. ' Else
  655. ' Me.MousePointer = vbDefault
  656. ' Call FctNoAccess: Exit Sub
  657. ' End If
  658. 'End If
  659. gstrUserCardNumber = Me.MSCommProximityReader.input
  660. If gstrUserCardNumber <> "" Then
  661. Me.lbl1.Caption = gstrUserCardNumber: Me.lbl1.Refresh
  662. gstrUserCode = LDAP_GetUserName_FromBadge(gstrUserCardNumber)
  663. If gstrUserCode = "" Then
  664. frmMsgBoxInfo.lblMelding.Caption = GetTxt("OnbekendeMagneetKaart") & " (AD)"
  665. frmMsgBoxInfo.Show vbModal, Me
  666. Else
  667. If LDAP_CheckUser_MemberOf_NestedGroups(gstrUserCode, "") Then
  668. Me.MousePointer = vbDefault
  669. Call FctWriteToHistory_LogOn("LogOn", "Code = " & gstrUserCode & " F = " & gvarUserAccessCode, "")
  670. Call FctEnabled_MenuItemsAndButtons(False)
  671. Else
  672. Me.MousePointer = vbDefault
  673. Call FctNoAccess: Exit Sub
  674. End If
  675. End If
  676. End If
  677. End If
  678. '#Sipass gebruikers, St Jozef Zoersel & AZRonse & HH Mol Erica (nog niet actief) & ASZAalst & HF_Rumst
  679. If gintProximityReaderType = cProximitySiemensAR6181RX And gstrCustomerName <> "StElisabethHerentals" Then
  680. Dim mReadTxt As String
  681. Dim mPollString As String
  682. Dim mPollAnswer As String
  683. Dim mSiPassUserGroup As String
  684. '
  685. mReadTxt = ""
  686. mPollString = FctConvert_HexToAscii("807F29")
  687. gstrUserCode = ""
  688. gstrUserCode_DoubleCheck = ""
  689. mSiPassUserGroup = ""
  690. gvarUserAccessCode = ""
  691. gvarUserAccessCode_DoubleCheck = ""
  692. gstrUserAfdelingCode = ""
  693. gstrUserAfdelingNaam = ""
  694. '
  695. Me.MSCommProximityReader.output = mPollString
  696. Sleep (100)
  697. mPollAnswer = Me.MSCommProximityReader.input
  698. '
  699. If Len(mPollAnswer) > 2 Then
  700. frmMain.sbStatusBar.Panels(1).Text = "Badge = "
  701. If gstrCustomerName = "ASZAalst" Or gstrCustomerName = "HF_Rumst" Then
  702. If gstrCustomerName = "ASZAalst" Then
  703. If Len(mPollAnswer) >= 15 Then gstrUserCardNumber = mID(mPollAnswer, 3, 6)
  704.  
  705. End If
  706. If gstrCustomerName = "HF_Rumst" Then
  707. If Len(mPollAnswer) >= 14 Then
  708. gstrUserCardNumber = mID(mPollAnswer, 3, 10)
  709. gstrUserCardNumber = Trim(str(Val(gstrUserCardNumber)))
  710. End If
  711. End If
  712. Else
  713. For i = 1 To Len(mPollAnswer)
  714. mReadTxt = mReadTxt & Hex$(Asc(mID(mPollAnswer, i, 1))) & ","
  715. Next i
  716. mReadTxt = mID(mReadTxt, 1, Len(mReadTxt) - 1)
  717. 'Cardnummer uitvissen
  718. For i = 7 To 15 '9 Char lang
  719. gstrUserCardNumber = gstrUserCardNumber & FctConvert_Trans4BitParity(Hex$(Asc(mID(mPollAnswer, i, 1))))
  720. Next i
  721. End If
  722. Else
  723. Exit Sub
  724. End If
  725. For i = 1 To 3 'Eventuele voorloopnullen verwijderen
  726. If mID(gstrUserCardNumber, 1, 1) = "0" Then
  727. gstrUserCardNumber = mID(gstrUserCardNumber, 2, Len(gstrUserCardNumber) - 1)
  728. End If
  729. Next i
  730. frmMain.sbStatusBar.Panels(1).Text = "Badge = " & gstrUserCardNumber
  731. Call FctSetAllDatabaseConnections(True)
  732. 'CardNo opzoeken in SiPass
  733. gconSiPassUserDatabase_Connection.ConnectionString = gstrSiPassUserDatabase_ConnectionString
  734. gconSiPassUserDatabase_Connection.Open
  735. If gconSiPassUserDatabase_Connection.State = adStateOpen Then
  736. Dim tmpRecSetSiPassUser As New ADODB.Recordset
  737. tmpRecSetSiPassUser.Open "SELECT * FROM vw__Employees_Vanas WHERE card_no='" & Trim(str(gstrUserCardNumber)) & "'", gconSiPassUserDatabase_Connection, adOpenStatic, adLockReadOnly, adCmdText
  738. If Not (tmpRecSetSiPassUser.BOF And tmpRecSetSiPassUser.EOF) Then
  739. If Not IsNull(tmpRecSetSiPassUser!Usergroup_Vanas) Then mSiPassUserGroup = Trim(tmpRecSetSiPassUser!Usergroup_Vanas)
  740. If Not IsNull(tmpRecSetSiPassUser!last_name) Then gstrUserCode = Trim(tmpRecSetSiPassUser!last_name)
  741. If gstrUserCode <> "" Then gstrUserCode = gstrUserCode & " "
  742. If Not IsNull(tmpRecSetSiPassUser!first_name) Then gstrUserCode = gstrUserCode & Trim(tmpRecSetSiPassUser!first_name)
  743. If Len(gstrUserCode) > 50 Then gstrUserCode = mID(gstrUserCode, 1, 50)
  744. If Not IsNull(tmpRecSetSiPassUser!afdeling) Then gstrUserAfdelingCode = Trim(tmpRecSetSiPassUser!afdeling)
  745. If Len(gstrUserAfdelingCode) > 50 Then gstrUserAfdelingCode = mID(gstrUserAfdelingCode, 1, 50)
  746. Else
  747. tmpRecSetSiPassUser.Close
  748. gconSiPassUserDatabase_Connection.Close
  749. ' Onbekende CardNo
  750. frmMsgBoxInfo.lblMelding.Caption = GetTxt("OnbekendeMagneetKaart")
  751. frmMsgBoxInfo.Show vbModal, Me
  752. 'ToDo komt FctShowMsgBoxInfo
  753. Call FctSetAllDatabaseConnections(False)
  754. Exit Sub
  755. End If
  756. tmpRecSetSiPassUser.Close
  757. gconSiPassUserDatabase_Connection.Close
  758. 'Via group toegangsrechten opzoeken
  759. tmpRecSet.Open "SELECT * FROM GebruikersGroepen WHERE ToegangsGroep='" & mSiPassUserGroup & "'", gcnMyConnection, adOpenStatic, adLockReadOnly, adCmdText
  760. If Not (tmpRecSet.BOF And tmpRecSet.EOF) Then
  761. If Not IsNull(tmpRecSet!ToegangsCode) Then gvarUserAccessCode = tmpRecSet!ToegangsCode
  762. tmpRecSet.Close
  763. 'Controle code
  764. If Val(gvarUserAccessCode) < 61 Or Val(gvarUserAccessCode) > 67 Then
  765. 'Verkeerde gebruikersgroep
  766. frmMsgBoxInfo.lblMelding.Caption = GetTxt("VerkeerdeGebruikersGroep6167")
  767. frmMsgBoxInfo.Show vbModal, Me
  768. 'ToDo komt FctShowMsgBoxInfo
  769. Call FctSetAllDatabaseConnections(False)
  770. Exit Sub
  771. End If
  772. Else
  773. tmpRecSet.Close
  774. ' Onbekende gebruikersgroep
  775. frmMsgBoxInfo.lblMelding.Caption = GetTxt("OnbekendeGebruikersGroep")
  776. frmMsgBoxInfo.Show vbModal, Me
  777. 'ToDo komt FctShowMsgBoxInfo
  778. Call FctSetAllDatabaseConnections(False)
  779. Exit Sub
  780. End If
  781. 'Controle OK buttons vrijgeven
  782. Call FctEnabled_MenuItemsAndButtons(False)
  783. Else
  784. MsgBox GetTxt("GebruikersDatabaseOnbereikbaarRaadpleegSysteemAdministrator"), vbInformation, gstrMsgBoxTitle
  785. End
  786. End If
  787. End If
  788. '#StAnnaStRemi / Chirec
  789. If gstrCustomerName = "Chirec" Then
  790. gstrUserCode = ""
  791. gstrUserCardNumber = Me.MSCommProximityReader.input
  792. gstrUserCardNumber = Replace(gstrUserCardNumber, Chr(10), "")
  793. gstrUserCardNumber = Replace(gstrUserCardNumber, Chr(13), "")
  794. If Len(gstrUserCardNumber) = 0 Then Exit Sub
  795. If Len(gstrUserCardNumber) = 12 Then gstrUserCardNumber = mID(gstrUserCardNumber, 2, 10)
  796. '
  797. frmMain.sbStatusBar.Panels(1).Text = "Badge = " & gstrUserCardNumber
  798. Call FctSetAllDatabaseConnections(True)
  799. 'Badge opzoeken
  800. gconSiPassUserDatabase_Connection.ConnectionString = gstrSiPassUserDatabase_ConnectionString
  801. gconSiPassUserDatabase_Connection.Open
  802. If gconSiPassUserDatabase_Connection.State = adStateOpen Then
  803. Dim tmpRecSetSiPassUser2 As New ADODB.Recordset
  804. tmpRecSetSiPassUser2.Open "SELECT COMM_BADGE, EMPLOYEE_LASTNAME, EMPLOYEE_FIRSTNAME, EMPLOYEE_FREE7 FROM Employee WHERE COMM_BADGE='" & gstrUserCardNumber & "'", gconSiPassUserDatabase_Connection, adOpenStatic, adLockReadOnly, adCmdText
  805. If Not (tmpRecSetSiPassUser2.BOF And tmpRecSetSiPassUser2.EOF) Then
  806. If Not IsNull(tmpRecSetSiPassUser2!EMPLOYEE_FREE7) Then gvarUserAccessCode = Trim(tmpRecSetSiPassUser2!EMPLOYEE_FREE7)
  807. If Not IsNull(tmpRecSetSiPassUser2!EMPLOYEE_LASTNAME) Then gstrUserCode = Trim(tmpRecSetSiPassUser2!EMPLOYEE_LASTNAME)
  808. If gstrUserCode <> "" Then gstrUserCode = gstrUserCode & " "
  809. If Not IsNull(tmpRecSetSiPassUser2!EMPLOYEE_FIRSTNAME) Then gstrUserCode = gstrUserCode & Trim(tmpRecSetSiPassUser2!EMPLOYEE_FIRSTNAME)
  810. If Len(gstrUserCode) > 50 Then gstrUserCode = mID(gstrUserCode, 1, 50)
  811. Else
  812. tmpRecSetSiPassUser2.Close
  813. gconSiPassUserDatabase_Connection.Close
  814. ' Onbekende Badge
  815. frmMsgBoxInfo.lblMelding.Caption = GetTxt("OnbekendeMagneetKaart")
  816. frmMsgBoxInfo.Show vbModal, Me
  817. 'ToDo komt FctShowMsgBoxInfo
  818. Call FctSetAllDatabaseConnections(False)
  819. Exit Sub
  820. End If
  821. tmpRecSetSiPassUser2.Close
  822. gconSiPassUserDatabase_Connection.Close
  823. 'Controle code
  824. If Val(gvarUserAccessCode) < 61 Or Val(gvarUserAccessCode) > 67 Then
  825. frmMsgBoxInfo.lblMelding.Caption = GetTxt("VerkeerdeGebruikersGroep6167")
  826. frmMsgBoxInfo.Show vbModal, Me
  827. 'ToDo komt FctShowMsgBoxInfo
  828. Call FctSetAllDatabaseConnections(False)
  829. Exit Sub
  830. Else
  831. If gstrUserCode = "" Then gstrUserCode = gstrUserCardNumber ' Indien geen naam + voornaam, badge wegschrijven als user
  832. Call FctEnabled_MenuItemsAndButtons(False)
  833. End If
  834. Else
  835. MsgBox GetTxt("GebruikersDatabaseOnbereikbaarRaadpleegSysteemAdministrator"), vbInformation, gstrMsgBoxTitle
  836. End
  837. End If
  838. End If
  839. '#StJanBrugge, StJanOostende
  840. 'Deze blok mag weg als de testen met Imprivata achter de rug zijn, 08/2017
  841. 'Deze blok moet blijven, want Philip Lacante wil de keuze behouden tussen Badge en Imprivata
  842. If gstrCustomerName = "StJanBrugge" Or gstrCustomerName = "StJanOostende" Then
  843. gstrUserCardNumber = Me.MSCommProximityReader.input
  844. If gstrUserCardNumber <> vbNullString Then
  845. SendMessage Me.hwnd, WM_SYSCOMMAND, SC_MONITORPOWER, MONITOR_ON
  846. Call FctSetAllDatabaseConnections(True)
  847. Sleep (100)
  848. gstrUserCardNumber = gstrUserCardNumber & Me.MSCommProximityReader.input
  849. If gstrCustomerName = "StJanBrugge" Then
  850. gstrUserCardNumber = Replace(gstrUserCardNumber, Chr(13) & Chr(10), "#")
  851. If Len(gstrUserCardNumber) = 32 Or Len(gstrUserCardNumber) = 42 Then
  852. If InStr(1, gstrUserCardNumber, "#") = 32 Then gstrUserCardNumber = mID(gstrUserCardNumber, 1, 16)
  853. If InStr(1, gstrUserCardNumber, "#") = 10 Then gstrUserCardNumber = mID(gstrUserCardNumber, 11, 16)
  854. For i = 2 To 16 Step 2
  855. Mid(gstrUserCardNumber, i, 1) = " "
  856. Next i
  857. End If
  858. If Len(gstrUserCardNumber) = 30 Or Len(gstrUserCardNumber) = 40 Then
  859. If InStr(1, gstrUserCardNumber, "#") = 30 Then gstrUserCardNumber = mID(gstrUserCardNumber, 1, 14)
  860. If InStr(1, gstrUserCardNumber, "#") = 10 Then gstrUserCardNumber = mID(gstrUserCardNumber, 11, 14)
  861. For i = 2 To 14 Step 2
  862. Mid(gstrUserCardNumber, i, 1) = " "
  863. Next i
  864. End If
  865. End If
  866. If gstrCustomerName = "StJanOostende" Then
  867. gstrUserCardNumber = Replace(gstrUserCardNumber, Chr(13) & Chr(10), "")
  868. If mID(gstrUserCardNumber, 1, 1) = "N" Then gstrUserCardNumber = mID(gstrUserCardNumber, 2, Len(gstrUserCardNumber) - 1)
  869. End If
  870. gstrUserCardNumber = Replace(gstrUserCardNumber, " ", "")
  871. Me.MSCommProximityReader.InBufferCount = 0
  872. Me.lbl1.Caption = gstrUserCardNumber
  873. '
  874. If gintUserControl_NumberOfHoursForExpiredPassword > 0 Then
  875. '#Indien aangemeld binnen de x uur gewoon toegang geven vanuit Historiekniveau
  876. '#Info FctGetUser_LastLogOnInHours default = -1
  877. Dim mLastLogOn As Long
  878. mLastLogOn = FctGetUser_LastLogOnInHours(gstrUserCardNumber)
  879. If mLastLogOn > -1 Then
  880. If gintUserControl_NumberOfHoursForExpiredPassword >= mLastLogOn Then
  881. Call FctWriteToHistory_LogOn("LogOn", "Card = " & gstrUserCardNumber & " Code = " & gstrUserCode & " F = " & gvarUserAccessCode & " History", "")
  882. Call FctEnabled_MenuItemsAndButtons(False)
  883. Me.MSCommProximityReader.InBufferCount = 0
  884. Exit Sub
  885. End If
  886. End If
  887. End If
  888. 'Met cardnummer (employeeNumber) de AD samaccountName opzoeken
  889. If LDAP_CheckUser_Attribute(gstrUserCardNumber) Then
  890. 'Paswoord nog opvragen
  891. gblnKeyboard_Input(3) = True
  892. Call FctPreparationKeyBoard
  893. frmKeyBoard.Show vbModal, Me
  894. If frmKeyBoard.txtKeyBoard.Text <> "" Then
  895. gstrUserPassword = frmKeyBoard.txtKeyBoard.Text
  896. If LDAP_CheckUser_MemberOf(gstrUserCode, gstrUserPassword) Then
  897. Call FctWriteToHistory_LogOn("LogOn", "Card = " & gstrUserCardNumber & "Code = " & gstrUserCode & " F = " & gvarUserAccessCode, "")
  898. Call FctEnabled_MenuItemsAndButtons(False)
  899. Else
  900. Call FctNoAccess
  901. Me.MSCommProximityReader.InBufferCount = 0
  902. Exit Sub
  903. End If
  904. End If
  905. Else
  906. Call FctNoAccess
  907. End If
  908. Me.MSCommProximityReader.InBufferCount = 0
  909. End If
  910. End If
  911. '#UPCKortenberg
  912. If gstrCustomerName = "UPCKortenberg" Then
  913. gstrUserCardNumber = Me.MSCommProximityReader.input
  914. If gstrUserCardNumber <> vbNullString Then
  915. Me.lbl1.Caption = gstrUserCardNumber
  916. gstrUserCardNumber = Replace(gstrUserCardNumber, Chr(10), "")
  917. gstrUserCardNumber = Replace(gstrUserCardNumber, Chr(13), "")
  918. Call FctSetAllDatabaseConnections(True)
  919. gstrUserCode = FctObasi_AuthenticateBadge(gstrUserCardNumber)
  920. If gstrUserCode <> "" Then
  921. 'Eerst paswoord nog opvragen
  922. gblnKeyboard_Input(4) = True
  923. Call FctPreparationKeyBoard
  924. frmKeyBoard.Show vbModal, Me
  925. If frmKeyBoard.txtKeyBoard.Text <> "" Then
  926. gstrUserPassword = frmKeyBoard.txtKeyBoard.Text
  927. gstrUserPassword = FctFilterSQLStringProblem(gstrUserPassword)
  928. gvarUserAccessCode = FctObasi_AuthenticateUser(gstrUserCode, gstrUserPassword)
  929. If Val(gvarUserAccessCode) < 61 Or Val(gvarUserAccessCode) > 68 Then
  930. Call FctNoAccess: Exit Sub
  931. Else
  932. gstrUserLanguage = gstrStartLanguage
  933. Call FctWriteToHistory_LogOn("LogOn", "Code = " & gstrUserCode & " F = " & gvarUserAccessCode, "")
  934. Call FctEnabled_MenuItemsAndButtons(False)
  935. End If
  936. Else
  937. Call FctSetAllDatabaseConnections(False)
  938. Exit Sub
  939. End If
  940. Else
  941. Call FctNoAccess: Exit Sub
  942. End If
  943. End If
  944. End If
  945. '#StAugustinusVeurne
  946. If gstrCustomerName = "StAugustinusVeurne" Then
  947. gstrUserCardNumber = Me.MSCommProximityReader.input
  948. If gstrUserCardNumber <> vbNullString Then
  949. If Not Right(gstrUserCardNumber, 1) = Chr(3) Then
  950. Sleep (100)
  951. gstrUserCardNumber = gstrUserCardNumber & Me.MSCommProximityReader.input
  952. End If
  953. Me.lbl1.Caption = gstrUserCardNumber
  954. gstrUserCardNumber = FctFilterProximityInputs(gstrUserCardNumber)
  955. If Len(gstrUserCardNumber) >= 12 Then gstrUserCardNumber = mID(gstrUserCardNumber, 5, 8)
  956. Me.lbl1.Caption = gstrUserCardNumber
  957. 'Met cardnummer (employeeNumber) de AD samaccountName opzoeken
  958. gstrUserCode = LDAP_GetUserName_FromAttribute(gstrUserCardNumber)
  959. If gstrUserCode <> vbNullString Then
  960. Me.lbl2.Caption = gstrUserCode
  961. If LDAP_CheckUser_MemberOf_NestedGroups(gstrUserCode, "") Then 'Fix paswoord in de connectie
  962. Call FctSetAllDatabaseConnections(True)
  963. Call FctWriteToHistory_LogOn("LogOn", "Card = " & gstrUserCardNumber & "Code = " & gstrUserCode & " F = " & gvarUserAccessCode, "")
  964. Call FctEnabled_MenuItemsAndButtons(False)
  965. Else
  966. Call FctNoAccess: Exit Sub
  967. End If
  968. Else
  969. Call FctNoAccess
  970. End If
  971. End If
  972. End If
  973. '#GZA
  974. If gstrCustomerName = "GZA" Then
  975. gstrUserCardNumber = Me.MSCommProximityReader.input
  976. If gstrUserCardNumber <> vbNullString Then
  977. If Not Right(gstrUserCardNumber, 1) = Chr(3) Then
  978. Sleep (100)
  979. gstrUserCardNumber = gstrUserCardNumber & Me.MSCommProximityReader.input
  980. End If
  981. Me.lbl1.Caption = gstrUserCardNumber
  982. gstrUserCardNumber = FctFilterProximityInputs(gstrUserCardNumber) 'Indien geen probleem kan deze functie hierboven in deze sub verschillende keren aangepast worden.
  983. If Len(gstrUserCardNumber) <> 13 Then Exit Sub
  984. gstrUserCardNumber = mID(gstrUserCardNumber, 5, 8)
  985. gstrUserCardNumber = FctConvert_HexToBin(gstrUserCardNumber)
  986. gstrUserCardNumber = mID(gstrUserCardNumber, 10, 16)
  987. gstrUserCardNumber = FctConvert_BinToDec(gstrUserCardNumber)
  988. Call FctSetAllDatabaseConnections(True)
  989. 'Cardnummer opzoeken in onze 'Gebruiker'tabel, veld 'GebruikerBadge'
  990. Me.lbl2.Caption = gstrUserCardNumber
  991. tmpRecSet.Open "SELECT * FROM Gebruikers WHERE GebruikerBadge='" & gstrUserCardNumber & "'", gcnMyConnection, adOpenStatic, adLockReadOnly, adCmdText
  992. If Not (tmpRecSet.BOF And tmpRecSet.EOF) Then
  993. If Not IsNull(tmpRecSet!GebruikerCode) Then gstrUserCardNumber = tmpRecSet!GebruikerCode
  994. End If
  995. tmpRecSet.Close
  996. Me.lbl2.Caption = Me.lbl2.Caption & " - " & gstrUserCardNumber
  997. If gstrUserCardNumber <> "" Then
  998. tmpRecSet.Open "SELECT * FROM CacheGebruikers WHERE GebruikersNaam ='" & gstrUserCardNumber & "'", gcnMyConnection, adOpenStatic, adLockReadOnly, adCmdText
  999. If Not (tmpRecSet.BOF And tmpRecSet.EOF) Then
  1000. If Not IsNull(tmpRecSet!GebruikersNaam) Then
  1001. gstrUserCode = tmpRecSet!GebruikersNaam
  1002. If Not IsNull(tmpRecSet!FunctieCode) Then gvarUserAccessCode = tmpRecSet!FunctieCode
  1003. End If
  1004. End If
  1005. tmpRecSet.Close
  1006. End If
  1007. Me.lbl2.Caption = Me.lbl2.Caption & " - " & gstrUserCode & " - " & gvarUserAccessCode
  1008. If Val(gvarUserAccessCode) < 61 Or Val(gvarUserAccessCode) > 68 Then
  1009. Call FctNoAccess: Exit Sub
  1010. Else
  1011. gstrUserLanguage = gstrStartLanguage
  1012. Call FctWriteToHistory_LogOn("LogOn", "Code = " & gstrUserCode & " F = " & gvarUserAccessCode, "")
  1013. Call FctEnabled_MenuItemsAndButtons(False)
  1014. End If
  1015. End If
  1016. End If
  1017.  
  1018. Exit Sub
  1019. errorhandler:
  1020. If Err.Number = 5 Then Exit Sub 'AZGlorieux blijkbaar iets te maken met Proximity reader, roept FctConvert_Trans4BitParity(Hex$(Asc(mID(mPollAnswer, I, 1))))
  1021. If Err.Number = 400 Then 'Form already displayed: can't show modally, klavier aanmelden is blijkbaar manueel opgeroepen
  1022. If Not (gintProximityReaderType = cProximityUSBOmnikey5x21 And gstrCustomerName = "AZDamiaan") Then
  1023. Dim mRetVal2 As String
  1024. mRetVal2 = Me.MSCommProximityReader.input
  1025. End If
  1026. Exit Sub
  1027. End If
  1028. If Err.Number = 8021 Then Exit Sub 'Internal error retrieving device control block for the port
  1029. If Err.Number = 3706 Then
  1030. MsgBox GetTxt("OracleSQLNetwerkonderdelenVoorToegangscontroleNietVoorzien"), vbInformation, gstrMsgBoxTitle
  1031. Exit Sub
  1032. End If
  1033. If Err.Number = -2147217911 Then 'Permission Denied
  1034. MsgBox ("'Permission Denied' Problems with the Server databaseconnection (SiPass), please contact the systeemadministrator !"), vbInformation, gstrMsgBoxTitle
  1035. Call FktWriteProgramStartStopLogFile("Pharmalogic stop : ODBC SiPass Connection problem")
  1036. End
  1037. End If
  1038. If Err.Number = -2147467259 Then 'SiPass, Infohos
  1039. MsgBox ("Problems with the Server databaseconnection , please contact the systeemadministrator !"), vbInformation, gstrMsgBoxTitle
  1040. Call FktWriteProgramStartStopLogFile("Pharmalogic stop : ODBC Connection problem")
  1041. End
  1042. End If
  1043. Select Case FctShowErrorBox(Me.Name, "tmrProximityReader_Timer")
  1044. Case vbAbort
  1045. Case vbRetry: Resume
  1046. Case vbIgnore: Resume Next
  1047. End Select
  1048. End Sub
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!