I need to build a tool that can Encrypt databases on server.
So far I have found this info (but that's not enough).
It's possible to check if database encrypted (works only locally) using NSFDbIsLocallyEncrypted.
Make a replica W32_NSFDbCreateAndCopy and set Encryption while creating replica (that will be applied on replica).
There is an undocumented Notes C API call that sets encryption flag for compact, but I could not make that work.
STATUS far PASCAL NSFDbLocalSecInfoSet(DBHANDLE hDB, WORD Option, BYTE EncryptStrength, char far *Username);
I have also read it is possible (for older ODS version) to change 'icon note' or to use DBINFO3 for newer ODS version (I could not make it work as well)
Does anybody know how to solve this task?
p.s. I have been told that HCL will come with proper solution in future (but not sure when).
Here is working code. I could not figure out, what to set as EncrytionStrength to remove local encryption using this code.
%REM
Agent encrypt
Created Dec 22, 2019 by Ulrich Krause/singultus
Description: Comments for Agent
%END REM
Option Public
Option Declare
Public Const W32_LIB = {nnotes.dll}
Declare Function W32_NSFDbCompactExtended Lib W32_LIB Alias {NSFDbCompactExtended} (ByVal Pathname As String, Options As Long, retStats As Long) As Integer
Declare Function W32_NSFDbLocalSecInfoSet Lib W32_LIB Alias {NSFDbLocalSecInfoSet} (ByVal hDb As Long, ByVal wOptions As Integer, ByVal EncryptStrength As Integer, ByVal Username As String) As Integer
Declare Function W32_NSFDbIsLocallyEncrypted Lib W32_LIB Alias {NSFDbIsLocallyEncrypted} ( ByVal hDB As Long, V As Integer) As Integer
Declare Sub W32_OSLoadString Lib W32_LIB Alias {OSLoadString} (ByVal null1 As Long, ByVal sError As Integer, ByVal errstr As String, ByVal lenstr As Integer)
Declare Function W32_NSFDbOpen Lib W32_LIB Alias {NSFDbOpen}(ByVal dbName As String, hDb As Long) As Integer
Declare Function W32_NSFDbClose Lib W32_LIB Alias {NSFDbClose} (ByVal hDb As Long) As Integer
Sub Initialize
Dim hDb As Long
Dim rc As Integer
Dim sDb As String
Dim retStats As Long
sDb = "serv01/singultus!!crash.nsf"
rc = W32_NSFDbOpen(sDb, hDb)
If rc = 0 Then
rc = W32_NSFDbLocalSecInfoSet(hDb, 0,1, "")
msgbox GetError(rc)
If rc = 0 Then
rc = W32_NSFDbCompactExtended (sDb, 0, retStats)
End if
rc = W32_NSFDbClose(hDb)
End If
End Sub
Function GetError (errnum As Integer) As String
Dim s As String*256
If IsDefined("WINDOWS") Then
W32_OSLoadString 0, errnum And &h03FFFFFFF, s, 256
Else
'TUX_OSLoadString 0, errnum And &h03FFFFFFF, s, 256
End If
getError = StrLeft(s, Chr(0))
End Function
You should look into the BCC solution DominoProtect or Ulrich Krause had other solution, Having database encryption on the server is a requirement for many compliance situations.
Related
I created an application in Access 2016 32 Bit, which in several update queries, log the user, by capturing it from Windows. We are now migrating to Windows 10 64 bit, and the code is not compatible. This is the code I have:
Private Declare Function apiGetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal IpBuffer As
String, nSize As Long) As Long
Function fOSUserName() As String
'Returns the network login name'
Dim IngLen As Long, IngX As Long
Dim strUserName As String
strUserName = String$(254, 0)
IngLen = 255
IngX = apiGetUserName(strUserName, IngLen)
If (IngX > 0) Then
fOSUserName = Left$(strUserName, IngLen - 1)
Else
fOSUserName = vbNullString
End If
End Function
Can someone give me a hand for a similar solution that works in 64 bit?
Thank you.
You need to migrate the API calls to make it compatible to 64-bit. Read Migrate Windows API-Calls in VBA to 64-bit
The correct syntax is:
Declare PtrSafe Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Also see Convert Windows API call to 64-bit in Excel VBA.
Function GetUNC(strMappedDrive As String) As String
Dim objFso As FileSystemObject
Set objFso = New FileSystemObject
Dim strDrive As String
Dim strShare As String
'Separated the mapped letter from
'any following sub-folders
strDrive = objFso.GetDriveName(strMappedDrive)
'find the UNC share name from the mapped letter
strShare = objFso.Drives(strDrive).ShareName '<<<< this is the line that the code fails on
'The Replace function allows for sub-folders
'of the mapped drive
GetUNC = Replace(strMappedDrive, strDrive, strShare)
Set objFso = Nothing 'Destroy the object
End Function
It works fine on my laptop and network, but when a colleague uses the same spreadsheet with the same code on their laptop and network the code throws a run-time error 5 exception 'invalid procedure call or argument' at the following line:
strShare = objFso.Drives(strDrive).ShareName
When I hover over the line of code I see: when I run the code to this point I see a file path.
My colleague has tried running the code on his local drive as well as a network drive with no success. We both have the same references selected as well. Does anyone know what I need to do to get this working on my colleagues machine?
Not entirely sure what the issue is, but it might be worth using an API call instead:
#If Win64 Then
Declare PtrSafe Function WNetGetConnection32 Lib "MPR.DLL" Alias "WNetGetConnectionA" (ByVal lpszLocalName As String, ByVal lpszRemoteName As String, lSize As Long) As Long
#Else
Declare Function WNetGetConnection32 Lib "MPR.DLL" Alias "WNetGetConnectionA" (ByVal lpszLocalName As String, ByVal lpszRemoteName As String, lSize As Long) As Long
#End If
Dim lpszRemoteName As String * lBUFFER_SIZE
Dim lSize As Long
Const NO_ERROR As Long = 0&
Const lBUFFER_SIZE As Long = 255&
Function GetUNC(ByRef strDriveLetter As String) As String
strDriveLetter = UCase$(strDriveLetter) & ":"
GetUNC = IIf(WNetGetConnection32(strDriveLetter, lpszRemoteName, lBUFFER_SIZE) = NO_ERROR, lpszRemoteName, "Error")
End Function
Then simply use something like:
MsgBox GetUNC("S")
Good afternoon folks -
I'm working on reading/writing an external file that is created and managed by a 3rd party that uses .INI structured files as its scripting language. I've got a wrapper working pretty well however, the section names are static with a unique number at the end ([GENERAL-1]) so that you have have the same task more than once. I am using VB.NET w/ VS2008.
My code below can successfully read a key from a section that is hardcoded but I'd like the key to be generic.
INI
test.ini
[GENERAL-1]
SUPPRESSTASKERRORS=Y
TASKERRORSENDJOB=Y
Code:
Declare Function GetPrivateProfileString Lib "kernel32.dll" Alias
"GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As
String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As
Long, ByVal lpFileName As String) As Long
Declare Function WriteProfileString Lib "kernel32.dll" Alias
"WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As
String, ByVal lpString As String, ByVal lpFileName As String) As Long
' Read INI file
Dim uname As String ' receives the value read from the INI file
Dim slength As Long ' receives length of the returned string
Dim OriginalMJB As String = "c:\test\test.ini"
uname = Space(1024)
slength = GetPrivateProfileString("General-1", "SUPPRESSTASKERRORS", "anonymous",
uname, 1024, OriginalMJB)
Notice the General-1 above, if I have the value hardcoded as -1 I can read the input .ini file without a problem. Any thoughts on how I can get and use the value left of the hyphen?
Any help is appreciated!
--George
Here's one way. From here you should be able to make SectionNo equal the specific section you want.
Dim section As String = "General"
Dim SectionNo as String = "-"
Dim Number as Integer = 1
SectionNo += Number.ToString
slength = GetPrivateProfileString(section + SectionNo, "SUPPRESSTASKERRORS", "anonymous", uname, 1024, OriginalMJB)
Here's a couple of options
Dim SectionName As String = "General-1"
Dim SectionCategorie As String = ""
Dim Section As String = ""
'Using Split - It returns an array so you can load the results into an array
'or just call it and load the specific index each time.
SectionCategorie = Split(SectionName, "-")(0)
Section = Split(SectionName, "-")(1)
'Using Substring
SectionCategorie = SectionName.Substring(0, SectionName.IndexOf("-"))
Section = SectionName.Substring(SectionName.IndexOf("-") + 1)
I am working on a program in Visual Basic 2008, I am required to have different types of sounds with varying volumes. Hence My.Computer.Audio.Play is not a valid option.
I decided to use mciSendString instead and found the following code
Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" _
(ByVal lpstrCommand As String, ByVal lpstrReturnString As String, _
ByVal uReturnLength As Integer, ByVal hwndCallback As Integer) As Integer
mciSendString("close myWAV", Nothing, 0, 0)
Dim fileName1 As String =
mciSendString("open " & fileName1 & " type mpegvideo alias myWAV", Nothing, 0, 0)
mciSendString("play myWAV", Nothing, 0, 0)
'min Volume is 1, max Volume is 1000
Dim Volume As Integer = (SFXVolume * 100)
mciSendString("setaudio myWAV volume to " & Volume, Nothing, 0, 0)
Now this code I have tested and is working perfectly when filename1 = "C://Correct.wav"
However when I use
filename1 = My.Application.Info.DirectoryPath & "\Correct.wav"
I get no sound play whatsoever.
Could anyone please help me correct my code so that this works.
Thank you in advance.
If your DirectoryPath has spaces then mciSendString won't be able to recognize the command accurately, you need to surround the path with quotes:
mciSendString(
String.Format("open ""{0}"" type mpegvideo alias myWAV", fileName1), Nothing, 0, 0)
Be sure to check returned status as well, as Hans suggests.
Also, since you don't know whether DirectoryPath has a trailing backslash or not, the accurate way to produce full path from directory and name is:
fileName1 = System.IO.Path.Combine(My.Application.Info.DirectoryPath, "Correct.wav")
Use Private Declare Function SetCurrentDirectory Lib "kernel32" Alias "SetCurrentDirectoryA" (ByVal lpPathName As String) As Long then SetCurrentDirectory filepath before opening file for play. That is working for me.
You need to use the DLL Call GetShortPathName in order to pass file paths to WINMM.DLL.
lpszLongPath is your full path string, and the short pathname will be passed to lpszShortPath.
cchbuffer should really be set to 200 or so, though in most cases, the returned string will be much shorter. You should use a VB padded string.
Private Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long
I have just used the mciSendString calls in a batch midi-file reading programme, opening 3642 midi files and returning copyright, title and play duration strings actually quite quickly!
Best Regards
David R Leach
) I am trying to send a short text from a VB app to Delphi app.. here is the
VB Code: Sender Program "Sender"
Public Class SendData
Const WM_COPYDATA = &H4A
Public Structure CopyDataStruct
Public dwData As Integer
Public cbData As Integer
Public lpData As String
End Structure
Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As _
CopyDataStruct) As Long
Private Sub SendData(ByVal cds)
Dim iHwnd As Long
Dim SS As String = "Test String less than 30 Char"
Dim cds As CopyDataStruct
cds.dwData = 0
cds.cbData = Len(SS)
cds.lpData = SS
iHwnd = FindWindow(0&, "Receive")
SendMessage(iHwnd, &H4A, Me.Handle, cds)
End Sub
here is the Delphi Code: Receiver program "Receive"
procedure TForm1.HandleCopyDataString(copyDataStruct: PCopyDataStruct);
var
s : string;
begin
s := PChar(CopyDataStruct.lpData);
cdMemo.Lines.Add(Format('Received data "%s" at %s',[s, TimeToStr(Now)]));
end;
procedure TForm1.WMCopyData(var Msg: TWMCopyData) ;
var
s : string;
sText: array[0..255] of Char;
copyDataType : TCopyDataType;
begin
copyDataType := TCopyDataType(Msg.CopyDataStruct.dwData);
s := PChar(Msg.CopyDataStruct.dwData);
Form1.cdMemo.Lines.Add(Format('Data from: %d',[msg.From]));
HandleCopyDataString(Msg.CopyDataStruct);
case Msg.CopyDataStruct.dwData of 0: //we are being sent a string
begin
StrLCopy(sText, Msg.CopyDataStruct.lpData, Msg.CopyDataStruct.cbData);
Form1.Label1.Caption := sText;
end;
end;
end;
What am I doing wrong here? It is possible to send strings from VB to Delphi programs using WM_COPYDATA command, and SendMessage function?
please help me :-)
F
There are a few things wrong with your Delphi code.
The dwData field holds an integer, but you type-cast it to PChar, a pointer, and then assign it to your string. That's not the field where you stored your string data. That's lpData.
The string you pass is not null-terminated. The OS only promises to copy exactly as many bytes as you specify in the cbData field. That's not necessarily a problem, but you need to be aware of it when you read the string later. To assign s to hold the string copied from the other process, use SetString like this:
SetString(s, PAnsiChar(Msg.CopyDataStruct.lpData), Msg.CopyDataStruct.cbData);
You haven't shown what TCopyDataType is, but if it's anything other than an integer or integer-subrange type, you're using it wrong. The dwData field is already a DWord, so you can use it wherever a numeric value is expected.
You're calling StrLCopy wrong. The third parameter should be the size of the destination buffer, not the source. It's meant to prevent buffer overflows by not copying more characters than will fit in the destination. The function expects to be able to detect the size of the source buffer by finding the terminating null character (but we already established that that won't be available). You could fix it like this:
StrLCopy(sText, Msg.CopyDataStruct.lpData,
Min(Length(sText), Msg.CopyDataStruct.cbData));
(Min is in the Math unit.)