this code is supposed to be used in VB. port number and IP address is available. how to prevent packets from entering is to be known. Its similar to the work a FireWall does.
Ur own Personal FIREwall!!
Here is some sample VB6 code to get You started.
It makes use of the winsock control to open and connect to a port itself.
Thereby it automatically denying access to port by other process.
Public Type MIB_TCPROW
dwState As Long
dwLocalAddr As Long
dwLocalPort As Long
dwRemoteAddr As Long
dwRemotePort As Long
End Type
Public Type MIB_TCPTABLE
dwNumEntries As Long
table(100) As MIB_TCPROW
End Type
Public MIB_TCPTABLE As MIB_TCPTABLE
Public Declare Function GetTcpTable Lib "iphlpapi.dll" (ByRef pTcpTable As
MIB_TCPTABLE, ByRef pdwSize As Long, ByVal bOrder As Long) As Long
Public Declare Function SetTcpEntry Lib "IPhlpAPI" (pTcpRow As MIB_TCPROW)
As Long
Public Declare Function ntohs Lib "WSOCK32.DLL" (ByVal netshort As Long) As
Long
Public Sub BlockPort
Dim LTmp As Long
Dim x As Integer, i As Integer, n As Integer
Dim RemP As String
Dim tcpt As MIB_TCPTABLE
LTmp = Len(MIB_TCPTABLE)
GetTcpTable tcpt, LTmp, 0
x = tcpt.dwNumEntries
For i = 0 To tcpt.dwNumEntries - 1
RemP = ntohs(tcpt.table(i).dwRemotePort)
If RemP = "8080" And tcpt.table(i).dwState <> 2 Then
tcpt.table(i).dwState = 12
SetTcpEntry tcpt.table(i)
End If
Next i
End Sub
If you are looking an easier way to block a single port then :
Use a Winsock Control in your VB form.
Set its localport property to the port number you want to block
Complete reference of Winsock for VB6 here
...and Thats IT!! Your own personal firewall is up!!
GoodLUCK!!
- CVS
Related
Below is the code where I create subfolder A from the path on cell E3. This is the path: C:\SW\A. But what if I want to create these subfolders (A and B and C) using 1 path like C:\SW\A\B\C? This doesn't create the subfolders.
Sub MakeFolders()
Dim path As String
'mkdir function
path = Range("E3").Value
MkDir path
End Sub
any idea how to make 3 subfolders using only 1 path?
The Win32API, MakeSureDirectoryExists, will do what you're asking for - it will check if each folder in the path exists, and if not, it will make it. To use APIs, you need to make sure that Declaration component sits at the start of a module (along with its accompanying function, BuildDirPath)
#If VBA7 Then
Private Declare PtrSafe Function MakeSureDirectoryPathExists Lib "imagehlp.dll" (ByVal DirPath As String) As Long
#Else
Private Declare Function MakeSureDirectoryPathExists Lib "imagehlp.dll" (ByVal DirPath As String) As Long
#End If
Function BuildDirPath(ByVal Path As String) As Boolean
BuildDirPath = CBool(MakeSureDirectoryPathExists(Path) = 1)
End Function
To use it, it's simply a matter of calling the function BuildDirPath.
Debug.Print BuildDirPath("C:\SW\A\B\C")
It will return a TRUE value if it was successful. I should add that this API is limited to ASCII characters and does not support Unicode - which means that it cannot be used for a non-Western character set (e.g., Japanese hiragana). Hope that helps.
So I've spent the evening trying to design snake in VBA. Great stuff. It seemed to be working fine whenever I ran the Main Sub from the VBA window (by clicking the play button in the top ribbon), however when I added a button on the worksheet for the same sub, it runs with no errors but the controls don't behave in the same way. Originally each time you press an arrow you just change direction, however when running the macro through a button you can keep holding the arrow in the direction you're going and it speeds up the snake, so the cell select behaves as it normally would in Excel, rather than as required in snake. This defeats the purpose of the game as the rest of the snake can't catch up with the head and creates gaps within allowing the user to just jump through it.
I'm using GetAsyncKeyState to read key presses:
#If VBA7 Then
Private Declare PtrSafe Function GetAsyncKeyState Lib "user32" _
(ByVal vKey As Long) As Integer
#Else
Private Declare Function GetAsyncKeyState Lib "user32" _
(ByVal vKey As Long) As Integer
#End If
Private Const VK_LEFT = &H25 'LEFT ARROW key
Private Const VK_UP = &H26 'UP ARROW key
Private Const VK_RIGHT = &H27 'RIGHT ARROW key
Private Const VK_DOWN = &H28 'DOWN ARROW key
And then calling this with If Statements:
' Key press handling
WasteTime (speed)
If GetAsyncKeyState(VK_DOWN) Then
PressDown
ElseIf GetAsyncKeyState(VK_UP) Then
PressUp
ElseIf GetAsyncKeyState(VK_LEFT) Then
PressLeft
ElseIf GetAsyncKeyState(VK_RIGHT) Then
PressRight
End If
' Offset by key direction or default
ActiveCell.Offset(cellrow, cellcol).Select
For reference, this is all that each key function does:
Function PressUp()
cellrow = -1
cellcol = 0
End Function
Any help would be greatly appreciated. I suspect this has something to do with me declaring the GetAsyncKeyState function in the General Declarations section, but as I've never done this before, can't quite work out what I'm doing wrong. Thanks :)
How can I write a voice command in Dragon NaturallySpeaking that holds a key down for X seconds?
The following voice command will hold the key CTRL for three seconds. You can change the key as well as how long the key is being hold down.
' Tested with Dragon NaturallySpeaking 12.5 Professional on Windows 7 SP1 x64 Ultimate
' From http://nuance-community.custhelp.com/posts/2cd74d2484
' Lindsay Adam
' www.pcbyvoice.com
Declare Function keybd_event Lib "user32.dll" (ByVal vKey As _
Long, bScan As Long, ByVal Flag As Long, ByVal exInfo As Long) As Long
' You can find all the virtual key codes in the following link:
' http://msdn.microsoft.com/en-us/library/ms927178.aspx
Const VK_CTRL = 17
Sub Main
keybd_event(VK_CTRL,0,0,0)
Wait(3)
keybd_event(VK_CTRL,0,2,0)
End Sub
http://msdn.microsoft.com/en-us/library/ms927178.aspx (their robots.txt doesn't allow me to mirror their website with https://web.archive.org):
How do you use an environment variable in an Excel sheet connection string, getting the error, ODBC Excel Driver Login Failed ... is not a valid path
If the provider errors then its not expanding the strings and you will need to do it manually, running the string through a function before assigning.
In a module:
Private Declare Function ExpandEnvironmentStrings Lib "kernel32" Alias "ExpandEnvironmentStringsA" (ByVal lpSrc As String, ByVal lpDst As String, ByVal nSize As Long) As Long
Public Function ExpandEnv(str As String) As String
Dim size As Long
size = ExpandEnvironmentStrings(str, ExpandEnv, size)
ExpandEnv = Space$(size)
size = ExpandEnvironmentStrings(str, ExpandEnv, size)
ExpandEnv = Left$(ExpandEnv, size - 1)
End Function
For
?ExpandEnv("aaa %temp% bbb %username% ccc")
aaa C:\NULL bbb AlexK ccc
I just want to confirm regarding the "SHELLEXECUTEINFO" in lotus script. I believe it is for windows. Does it also works in Window Server 2003? I can't test it since I don't have the required machine and another thing will this work on AIX, Linux or other OS? (I think not) If ever it really would not work is there some alternatives (A Lotus Script Code that would run any file and would work on any OS)? Thanks.
Sample Codes:
' Use in Executing the Batch File or Exe File
Declare Function GetActiveWindow Lib "user32.dll" () As Long
Type SHELLEXECUTEINFO
cbSize As Long
fMask As Long
hwnd As Long
lpVerb As String
lpFile As String
lpParameters As String
lpDirectory As String
nShow As Long
hInstApp As Long
lpIDList As Long
lpClass As String
hkeyClass As Long
dwHotKey As Long
hIcon As Long
hProcess As Long
End Type
Const SEE_MASK_NOCLOSEPROCESS = &H40
Const SW_SHOWNORMAL = 1
Declare Function ShellExecuteEx Lib "shell32.dll" Alias "ShellExecuteExA" (lpExecInfo As SHELLEXECUTEINFO) As Long
Const SE_ERR_FNF = 2
Declare Function WaitForSingleObject Lib "kernel32.dll" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Const INFINITE = &HFFFF
Const WAIT_TIMEOUT = &H102
As "shell32.dll" and "kernel32.dll" are available in every Windows- System (32Bit and 64Bit), this will work for every Windows system.
And for the same reason, this code will not work for any AIX / Linux / other OS, as they do not know the dlls...
If you just want to execute something and NOT have to wait for its completion, then using the built in LotusScript "shell"- function is absolutely sufficient.
Unfortunately I have no example code for any other way of doing this in NON Windows OS