Cybernomad
/
PSLine2000Documentation
1
0
Fork 0
Code Issues 1 Pull Requests Packages Projects 1 Releases Wiki Activity
PSLine2000Documentation/Modules/Module1.md

441 lines
15 KiB
Markdown
Raw Blame History

# Module1
Analysis generated on: 4/1/2025 5:13:26 PM
---
## VBA Code
```vba
Attribute VB_Name = "Module1"
Option Compare Database
Private Declare PtrSafe Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Private Declare PtrSafe Function WNetGetUser& Lib "mpr.dll" Alias "WNetGetUserA" (ByVal lpName As String, ByVal lpUserName As String, lpnLength As Long)
Private Const MAX_COMPUTERNAME_LENGTH = 15
Public Function myNTUserName$()
Dim s$, dl&, sz&
s$ = ""
t$ = ""
dl& = WNetGetUser&(t$, s$, lengt&)
s$ = String$(255, 0)
dl& = WNetGetUser&(t$, s$, lengt&)
dl& = WNetGetUser&(t$, s$, lengt&)
s$ = UCase$(StrRemove$(s$, Chr$(0)))
If usrID$ <> "" Then s$ = usrID$
myNTUserName$ = s$
End Function
Public Function myComputerName$()
Dim s$, dl&, sz&
sz = 255
s$ = String$(255, 0)
dl& = GetComputerName(s$, sz)
s$ = UCase$(StrRemove$(s$, Chr$(0)))
If usrID$ <> "" Then s$ = usrID$
myComputerName$ = s$
End Function
Sub CreateDir(MyDir)
If Dir(MyDir, vbDirectory) = "" Then MkDir (DestinationFolder)
End Sub
Public Function StrRemove$(st$, Rm$)
'
' This routine removes for the string st$ each character in rm$
'
stx$ = st$
For ir% = 1 To Len(Rm$)
rx$ = Mid$(Rm$, ir%, 1)
Do While (InStr(stx$, rx$) <> 0)
stp% = InStr(stx$, rx$)
stx$ = Left$(stx$, stp% - 1) + Mid$(stx$, stp% + 1)
Loop
Next
StrRemove$ = stx$
End Function
Public Sub loadCull(arrray$(), fileName$)
'
' array must be dim'ed as arrray$(100)
' 100 is maximum
' zero element contains # of entries in file
'
' Dim arrray$(100)
'
' used to cull keywords from a file in conjunction with Cull$
'
' file has
' key1 = 14
' key2 = freddy boy
' keyword = funny
'
' program has
'
' loadcull(arrray(),filename)
' key2$=cull("key2","")
' amount= val(cull("key1","0")) Note: amount = object that needs the val
'
If Exists(fileName$) Then
Close #11
Open fileName$ For Input As #11
i = 1
While Not EOF(11)
Line Input #11, arrray$(i)
i = i + 1
If i > 100 Then
arrray$(0) = "100"
Exit Sub
End If
Wend
Close #11
arrray$(0) = Trim(Str(i - 1))
Else
arrray$(0) = "0"
End If
End Sub
Public Function Cull2$(arrray$(), Keyword$, Default$)
'
'Gets any file you request from File
'
' array must be dim'ed as arrray$(100)
'
' zero element contains # of entries in file
'
' used to cull keywords from a file in conjunction with loadCull$
'
inflen = arrray$(0)
culled$ = Default$
For i = 1 To inflen
p$ = arrray$(i)
edi = Left$(p$, 14) 'edi is Record in file you are looking for
pz = InStr(UCase(edi), UCase(Keyword$))
If pz <> 0 Then
p$ = Mid$(p$, pz + Len(Keyword$))
pz = InStr(p$, "=")
If pz <> 0 Then
p$ = Mid$(p$, pz + 1)
End If
p$ = Left$(p$, Len(p$) - 1) 'if you want to delete last string Left$(P$, Len(P$) - 1)
culled$ = p$
Exit For
End If
Next
Cull2$ = culled$
End Function
Public Function Cull$(arrray$(), Keyword$, Default$)
'
'Gets any file you request from File
'
' array must be dim'ed as arrray$(100)
'
' zero element contains # of entries in file
'
' used to cull keywords from a file in conjunction with loadCull$
'
inflen = arrray$(0)
culled$ = Default$
For i = 1 To inflen
p$ = arrray$(i)
edi = Left$(p$, 20) 'edi is Record in file you are looking for
pz = InStr(UCase(edi), UCase(Keyword$))
If pz <> 0 Then
p$ = Mid$(p$, pz + Len(Keyword$))
pz = InStr(p$, "=")
If pz <> 0 Then
p$ = Mid$(p$, pz + 1)
End If
p$ = Left$(p$, Len(p$) - 1) 'if you want to delete last string Left$(P$, Len(P$) - 1)
culled$ = p$
Exit For
End If
Next
Cull$ = culled$
End Function
Sub LogFile(PN$, Action$)
Set LogFileQDB = DBEngine.Workspaces(0).Databases(0)
Set LogFileQset = LogFileQDB.OpenRecordset("LogFile") ' Create dynaset.
LogFileQset.AddNew
LogFileQset!PN = PN$
LogFileQset!Action = Action$
LogFileQset!Tech = myComputerName
LogFileQset!TimeStamp = Now()
LogFileQset.Update
End Sub
```
## What it does
#### Chunk 1
**Module1 Module**
====================
### Overview
This VBA module defines a single public function, `myNTUserName()`, which returns the NT username of the current user.
### Declarations
#### Private Declare Statements
The module declares two private functions using the `PtrSafe` keyword:
* `GetComputerName Lib "kernel32" Alias "GetComputerNameA"`: Retrieves the name of the computer where the VBA project is running. This function is not used in the provided code but might be useful for debugging or logging purposes.
* `WNetGetUser Lib "mpr.dll" Alias "WNetGetUserA"`: Retrieves information about a user on the network.
#### Constant
The module defines a constant, `MAX_COMPUTERNAME_LENGTH`, which specifies the maximum length of a computer name in characters (15).
### Public Function myNTUserName()
#### Purpose
The `myNTUserName()` function returns the NT username of the current user.
#### Parameters
None. This is a standalone function that does not accept any arguments.
#### Return Value
The function returns a string containing the NT username of the current user.
#### Implementation
1. The function initializes two empty strings, `s$` and `t$`, which are used to store the result and input data, respectively.
2. It then calls the `WNetGetUser` function with the computer name (`t$`) as an argument, passing by reference the length of the string that will contain the returned username (`lengt\u0026`). The function stores the result in the `dl\u0026` variable and the user ID in the `s$` variable.
3. It then calls the `WNetGetUser` function again with the same arguments to retrieve additional information about the current user, which is stored in the `dl\u0026` variable.
4. The function removes any null characters from the beginning of the `s$` string using the `StrRemove` function and converts it to uppercase using the `UCase` function.
5. If a valid username was retrieved (i.e., `usrID$ \u003c\u003e ""`), the function updates the `s$` variable with the provided username.
6. Finally, the function returns the formatted NT username in uppercase.
### Example Usage
```vba
Dim ntUsername As String
ntUsername = myNTUserName()
MsgBox ntUsername ' displays the current user's NT username
```
#### Chunk 2
**VBA Code Description**
=========================
### Overview
This VBA code consists of three functions: `myComputerName`, `CreateDir`, and `StrRemove`. The code provides functionality for retrieving the computer name, creating directories, and removing specific characters from a string.
### myComputerName Function
---------------------------
#### Purpose
Retrieves the current computer name, including the domain if present, and returns it as a uppercase string.
#### Parameters
None
#### Returns
A string representing the computer name.
#### Behavior
1. The `GetComputerName` function is used to retrieve the computer name from the operating system.
2. The retrieved string is converted to uppercase using the `UCase` function.
3. If an existing username is specified (stored in the `usrID$` variable), it is prepended to the computer name.
4. The resulting string is assigned to the `myComputerName$` variable.
### CreateDir Sub
------------------
#### Purpose
Creates a directory at the specified path if it does not already exist.
#### Parameters
None
#### Behavior
1. The `Dir` function is used to check if the specified directory exists.
2. If the directory does not exist, the `MkDir` function creates it.
Note: This code uses the `DestinationFolder` variable, which is not defined in this snippet. It is assumed that this variable is defined elsewhere in the codebase and points to the desired directory path.
### StrRemove Function
----------------------
#### Purpose
Removes specified characters from a string using a recursive approach.
#### Parameters
* `st$`: The input string.
* `Rm$`: The string containing characters to remove.
#### Returns
A string with all occurrences of the characters in `Rm$` removed.
#### Behavior
1. The input string is assigned to the `stx$` variable.
2. The length of the character string `Rm$` is iterated over using a `For` loop.
3. For each character, the function checks if it exists within the input string using the `InStr` function. If found, the character is removed from the string using the `Left` and `Mid` functions.
4. The resulting string without the removed characters is assigned to the `StrRemove$` variable.
Example use cases for these functions:
* `myComputerName` can be used in a script to retrieve the current computer name for use in various applications or workflows.
* `CreateDir` can be used to create directories for storing files, folders, or other data structures.
* `StrRemove` can be used to clean up strings by removing specific characters or to perform text processing tasks.
#### Chunk 3
**loadCull Subroutine**
========================
### Purpose
The `loadCull` subroutine is designed to load keyword data from a text file into an array, while also handling culling of keywords based on predefined criteria.
### Requirements
* The input array (`arrray$`) must be dimensioned as an array with a fixed maximum size (e.g., `100`) before calling this subroutine.
* The file containing the keyword data should have specific key values assigned to each keyword, such as `key1` = 14 and `key2` = "freddy boy".
### Parameters
* `arrray$`: The input array that will store the loaded keyword data. Must be dimensioned with a fixed maximum size (e.g., `100`) before calling this subroutine.
* `fileName$`: The name of the file containing the keyword data.
### Functionality
1. **File Existence Check**: The subroutine checks if the specified file exists using the `If Exists` statement.
2. **File Handling**: If the file exists, it is opened for input (`#11`) and iterated through line by line using a `While Not EOF(11)` loop.
3. **Array Population**: Each line of the file is read into the first element of the array (`arrray$(0)`) using the `Line Input` statement. The array index (`i`) is incremented for each line, and if `i` exceeds the maximum size (100), it sets the first element of the array to "100" and exits the subroutine.
4. **Trimming**: After the loop completes, the `arrray$(0)` element is trimmed using the `Trim` function and assigned the value of `Str(i - 1)`, effectively removing any trailing whitespace from the last line read.
5. **Culling**: If the file does not exist, the subroutine sets the first element of the array (`arrray$(0)`) to "0".
### Notes
* The `amount` variable is used within the culling function, but it's not referenced in this specific code snippet.
Here's an example use case:
```markdown
' Initialize the array with a fixed maximum size (e.g., 100)
Dim arrray$(100)
' Call the loadCull subroutine
loadCull(arrray$, "keyword_data.txt")
' Access the loaded keyword data
For i = 0 To UBound(arrray$)
Debug.Print arrray$(i)
Next i
```
In this example, `keyword_data.txt` is assumed to contain the keyword data with specific key values assigned to each keyword. The subroutine will load this data into the `arrray$` array and make it available for further processing.
#### Chunk 4
**Function Description: `Cull2$`**
### Purpose
The `Cull2$` function is designed to retrieve a specific keyword from a file and return the corresponding string. It is intended to be used in conjunction with the `loadCull$` function for keyword culling.
### Parameters
* `arrray$(100)`: The input array must be dimensioned as an array of 100 elements, where each element represents a line in the file.
* `Keyword$: String`: The specific keyword to search for in the files.
* `Default$`: Default value (String): The string to return if no match is found.
### Behavior
1. Initialize variables:
* `inflen` stores the number of entries in the input array (`arrray$(0)`).
* `culled$` is initialized with the default value and will store the matched string.
2. Loop through each entry in the input array (`i = 1 To inflen`):
* Extract the first 14 characters from the current line (`edi = Left$(p$, 14)`), which represents the record ID.
* Check if the keyword is present in the record ID using `InStr(UCase(edi), UCase(Keyword$))`.
* If a match is found, proceed to process the rest of the line:
* Extract the substring after the keyword using `Mid$(p$, pz + Len(Keyword$))`, where `pz` is the position of the keyword in the record ID.
* If an equals sign (`=`) is present after the keyword, extract the remaining substring using `Mid$(p$, pz + 1)`.
* Remove any trailing characters from the extracted string by taking its first `Len(p$) - 1` characters.
3. Return the matched string:
* Set `culled$` to the processed string.
4. Exit the loop and return the result:
### Return Value
The function returns the matched string or the default value if no match is found.
**Example Use Case**
```vba
Dim arr() As String
Redim arr(100)
arr(0) = "Record ID=Keyword1"
arr(1) = "Record ID=Keyword2=value"
arr(2) = "Record ID=Keyword3"
Set Keyword$ = "Keyword1"
Default$ = "No match found"
culled$ = Cull2$(arr, Keyword$, Default$)
Debug.Print culled$
```
In this example, the function will return `"value"`, which is the matched string after removing the equals sign.
#### Chunk 5
**Cull Function**
================
### Description
The `Cull` function is a VBA subroutine that takes three parameters: an array of strings (`arrray$`), a keyword to search for, and a default value. The function's purpose is to extract the last part of each string in the array that does not contain the specified keyword.
### Requirements
* `arrray$` must be dimensioned as an array with at least 100 elements.
* The first element of `arrray$` contains the number of entries in the file.
* The function is designed to work in conjunction with another function called `loadCull`.
### Step-by-Step Explanation
1. Retrieve the number of entries (`inflen`) from the array, which represents the number of files.
2. Initialize an empty string variable (`culled$`) and assign it the default value.
3. Iterate through each element in the array starting from index 1 to `inflen`.
4. Extract the first 20 characters of each string (`edi`) using `Left$(p$, 20)`, which represents the record in the file being processed.
5. Use `InStr` to find the position (`pz`) of the keyword (case-insensitive) within the extracted string.
6. If the keyword is found, remove it from the end of the string by taking a substring starting after the keyword.
7. Check if the remaining string contains an equals sign (`=`). If it does, remove it as well.
8. Update `culled$` with the processed string and exit the loop using `Exit For`.
9. After processing all files, return `culled$`, which now holds the last part of each file name without the keyword.
### Example Use Case
```vba
Dim myFiles() As String
myFiles = Array("file1.txt=C", "file2.txt=abc", "file3.txt")
Dim keyword As String = "C"
Dim culled$ As String
culled$ = Cull(myFiles, keyword, "")
Debug.Print culled$
```
Output:
```text
"file2.txt=abc file3.txt"
```
This example demonstrates how the `Cull` function can be used to extract specific parts of file names based on a given keyword.
Reference in New Issue View Git Blame Copy Permalink