Quantcast
Channel: VBForums
Viewing all 42083 articles
Browse latest View live

VS 2012 Checking internet connection

$
0
0
i wrote this code to check internet connection but when I run the program this is what it brings
Code:

Private Declare Function InternetGetConnectedState Lib "wininet" (ByRef conn As Long, ByVal val As Long) As Boolean

    Public Function CheckInternetConnection() As Boolean
        Dim Out As Integer
        If InternetGetConnectedState(Out, 0) = True Then
            Return True
        Else
            Return False
        End If
    End FunctionName:  check.jpg
Views: 12
Size:  20.7 KB

Attached Images
 

Recover focus

$
0
0
Hi,
I have some problem with a lost focus.

In order to prevent the user from modifying text boxes contents while the program is working I have placed the textboxes in a frame
I disable the frame when the job begins and enable it when the job is finished
the problem is that the focus goes to another control of the frame I.E. a button.

How can I for instance save the focus before disabling the frame ant set it back after re-enabling the frame ?

Other possible solution welcome
Thanks

Issues with a new external hard disk.

$
0
0
Hi
I have bought a new external hard disk and have attached it to my computer.
It appears that it is working fine.
However, I have two little issues with it:

1. My computer identifies the new external hard disk as disk D and the older external hard disk as disk E (it has always identified it as E, because at some point in the past there was another much older external hard disk D which no longer is used).
So, the way these names or labels D and E are designated is in the REVERSE chronological order, which is counter intuitive and very unpleasant.
I would prefer to have the old one (currently E) to be identified as D and the new one (currently D) to be identified as E.
How can I make my computer reallocate these two labels according to my preference?

2. The new external hard disk (Seagate portable storage Slim)(which has the capacity of 4 TB) has some files on it. One is Start_Here_Win.exe which is Seagate product registration software for Windows (there is another one for mac which doesn't apply to me)
The little booklet that comes with this external hard disk says begin here.
Now, my question is:
Why should I run this program Start_Here_Win.exe?
What does it do?
If I connect the same external hard disk to multiple computers (all of them running Windows), should I run this on all of them?
I haven't run it, and yet the external hard disk appears to work fine and everything looks good, so why run this strange exe file? If it ain't broke, don't fix it.
I didn't run anything like this on my previous external hard disks (WD and Verbatim) and there was no problem. I don't think they even had such thing.
Any comment or response to this would be appreciated

Please advise.
Thanks.

change the registry key value

$
0
0
Can I use VB6 to change the value of a key in the registry if the user has no administrator rights.
Password and login admin can be sucked in the code

VS 2017 INotifyPropertyChanged Help Required

$
0
0
Hi,

I'm not sure if I am missing something or if it is even possible. But hopefully someone can point me in the right direction.

First I have created a custom control (TextBox) to Implement a couple of properties. (Fieldname, and IsReadOnly).

This issue I am having is. If I set the IsReadOnly Property Boolean value to True, the control is not Notified of the change in RunTime. I can debug as far as the RaiseEvent.

If I've taken the wrong approach then please let me know.


*-*******

The first code is the customControlProperties Class

** Custom Control Properties **

Code:

Imports System.ComponentModel
Imports System.Runtime.CompilerServices

<TypeConverterAttribute(GetType(System.ComponentModel.ExpandableObjectConverter))>
Public Class ControlSQLProperties
    Implements INotifyPropertyChanged

    Private m_IsReadOnly As Boolean

    Public Property FieldName As String
    Public Property IsReadOnly As Boolean
        Get
            Return m_IsReadOnly
        End Get
        Set(value As Boolean)
            m_IsReadOnly = value

            NotifyPropertyChanged()
        End Set
    End Property

    Public Event PropertyChanged As PropertyChangedEventHandler Implements INotifyPropertyChanged.PropertyChanged

    Public Sub NotifyPropertyChanged(<CallerMemberName()> Optional ByVal propertyName As String = Nothing)
        RaiseEvent PropertyChanged(Me, New PropertyChangedEventArgs(propertyName))
    End Sub

End Class

Interface to customControlProperties

Code:

Public Interface IControlSQLProp
    Property SQLProperties As ControlSQLProperties
End Interface

Code within the TextBox Control

Code:

Implements IControlSQLProp


#Region "Custom Properties"
    Private WithEvents IsReadOnly As New ControlSQLProperties

    Private Sub _IsReadOnly_PropertyChanged(sender As Object, e As PropertyChangedEventArgs) Handles IsReadOnly.PropertyChanged
        Invalidate()

        Properties.ReadOnly = SQLProperties.IsReadOnly ' DevExpress Control



    End Sub

    Public Property SQLProperties As New ControlSQLProperties Implements IControlSQLProp.SQLProperties


#End Region

[RESOLVED] Want Ubuntu bootable USB stick. How do I create one from Win.10?

$
0
0
I have an old Windows 7 laptop that is now too slow to use, so I want to try Linux instead of throwing it away.

Ubuntu seems to be the most recommended one, so I've downloaded the ISO onto my Windows 10 laptop. But how do I burn it onto a USB stick making it bootable? The Ubuntu site says to use something called Rufus, obtainable from Microsoft, but the link is dead and I can't find it on the Microsoft site. I can't find any software on my Windows 10 laptop that allows me create a bootable USB stick.

[RESOLVED] XoJo...develop VB6-like apps for Mac OS

$
0
0
As the secretary who uses some of my VB6 Windows-created applications has 'migrated' (backwards?) to a Mac desktop computer, I have a few options. One, is for her to purchase Parallels so that she can run both Mac OS and Windows 10 (of course she would need to purchase the Windows OS as well) 'simultaneously' without rebooting her Mac (Bootcamp requires rebooting from one OS to another).

Another option I THINK I have is XoJo. It purports to operate in Windows, 'on the web', in mobile configuration (iOS), and possibly macOS (OSX).

Has anyone used this tool? I have downloaded and installed the 'windows' version, but do not see an option to create something for a Mac desktop, only iOs. I DO have a Mac available to download the macOS version, but prefer to create everything on my PC, and then 'install' the apps on the Mac. Possible?

It has similarities to VB6, that is the main reason I wanted to try it...but before I get too far, am interested if anyone else has used it, and can create cross-platform apps on a Windows based PC.

User Access Control

$
0
0
Is it possible to prevent the User Access Control's warning 'Do you wish to allow this programme to make changes etc' every time my programme starts?

I run a manifest resource, but wonder if that is enough!

Resource:

<assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0">
<assemblyIdentity
version="3.0.0.0"
processorArchitecture="X86"
name="Music Master"
type="win32"
/>
<description>Library/Player</description>
<dependency>
<dependentAssembly>
<assemblyIdentity
type="win32"
name="Microsoft.Windows.Common-Controls"
version="6.0.0.0"
processorArchitecture="X86"
publicKeyToken="6595b64144ccf1df"
language="*"
/>
</dependentAssembly>
</dependency>
<compatibility xmlns="urn:schemas-microsoft-com:compatibility.v1">
<application>
<!-- Windows 10 -->
<supportedOS Id="{8e0f7a12-bfb3-4fe8-b9a5-48fd50a15a9a}"/>
<!-- Windows 8.1 -->
<supportedOS Id="{1f676c76-80e1-4239-95bb-83d0f6d0da78}"/>
<!-- Windows 8 -->
<supportedOS Id="{4a2f28e3-53b9-4441-ba9c-d69d4a4a6e38}"/>
<!-- Windows 7 -->
<supportedOS Id="{35138b9a-5d96-4fbd-8e2d-a2440225f93a}"/>
<!-- Windows Vista -->
<supportedOS Id="{e2011457-1546-43c5-a5fe-008deee3d3f0}"/>
</application>
</compatibility>
<!-- Identify the application security requirements: Vista and above -->
<trustInfo xmlns="urn:schemas-microsoft-com:asm.v2">
<security>
<requestedPrivileges>
<requestedExecutionLevel
level="highestAvailable"
uiAccess="false"
/>
</requestedPrivileges>
</security>
</trustInfo>
<!-- Identify advanced options: Vista and above -->
<asmv3:application xmlns:asmv3="urn:schemas-microsoft-com:asm.v3">
<asmv3:windowsSettings xmlns="http://schemas.microsoft.com/SMI/2005/WindowsSettings">
<autoElevate>true</autoElevate>
</asmv3:windowsSettings>
</asmv3:application>
</assembly>

VS 2017 Numeric Comparison gived a false result

$
0
0
Hello fellows!

I have a problem with this type of code:

Code:

Private sub button1_click()

Dim firstp as integer
Dim secondp as integer

Firstp = textbox1.text
Secondp = textbox2.text

If firstp >= secondp then
Msgbox("1 is equal or bigger")
Else
Msgbox("2 is bigger")
End if


This code sometimes works and sometimes gived me a false reault, like if textbox1 value is 50 and textbox2 value is 54
It still sais sometimes that the value of the first one is bigger

VS 2017 [RESOLVED] Issue with code I didn't realize (Facepalm)

$
0
0
So I thought this worked, maybe it did at some point and is one of those strange things, or maybe not and I just didn't notice.

So basically, if the listbox has no items, you show the label, that says "No History!" but if there is 1 or more items you don't show the label.

This is the code I thought would work, but it turns out it don't work.

Code:

    If ListBox1.Items.Count > 0 Then
            Label2.Visible = True
        ElseIf ListBox1.Items.Count < 0 Then
            Label2.Visible = False
        End If

Could someone explain what is wrong, and what a better way to complete this would be?

Thanks!

tcplistener data listener streamsockets keep connection alive

$
0
0
Hi.
This is in C# but I will translate to VB when i finish.
I need a general idea on how I can keep a connection alive on a datalistener -responder.
The idea is to open the server to listen. After that( see code), I am receiving and sending data. What I need to do here is not to close the connection when the task is over.

I have an app that open the connection and after that it send data, when data is send and I click on sendind data AGAIN (see Listener_ConnectionReceived event) I get an error that the connection cannot be established - failed to respond.
The general idea (probably) is to have a listof SocketServer classes than never close, unless a close button is clicked on the remote form or the remote workstation has been closed-disconnected by mistake or on error etc.
The main server can receive connection from multiple workstations and handle their connections individually.

I have made the basic for sending and receiving data but as I've said, I don't know how to keep this alive (maybe the problem is here: SentResponse_Writer.DetachStream(); , will check).


Any ideas?

thanks.

Code:

class SocketServer
    {
        private readonly int _port;
        public int Port { get { return _port; } }

        private StreamSocket ConnectionSocket;

        private StreamSocketListener listener;

        public delegate void DataRecived(string data);
        public event DataRecived OnDataRecived;


        public delegate void Error(string message);
        public event Error OnError;
        public SocketServer(int port)
        {
            _port = port;
        }
        private string ServerPort = "4069";

 
        public void Start()
        {
            listener = new StreamSocketListener();
            listener.ConnectionReceived += Listener_ConnectionReceived;
            listener.BindServiceNameAsync(ServerPort).AsTask().Wait();
        }

 private async void Listener_ConnectionReceived(StreamSocketListener sender, StreamSocketListenerConnectionReceivedEventArgs args)
        {

            DataReader DataListener_Reader;
            StringBuilder DataListener_StrBuilder;
            string DataReceived;

            try
            {
                using (DataListener_Reader = new DataReader(args.Socket.InputStream))
                {
                    DataListener_StrBuilder = new StringBuilder();
                    DataListener_Reader.InputStreamOptions = InputStreamOptions.Partial;
                    DataListener_Reader.UnicodeEncoding = Windows.Storage.Streams.UnicodeEncoding.Utf8;
                    DataListener_Reader.ByteOrder = ByteOrder.LittleEndian;
                    await DataListener_Reader.LoadAsync(256);
                    while (DataListener_Reader.UnconsumedBufferLength > 0)
                    {
                        DataListener_StrBuilder.Append(DataListener_Reader.ReadString(DataListener_Reader.UnconsumedBufferLength));
                      // await DataListener_Reader.LoadAsync(256);
                    }
                    DataListener_Reader.DetachStream();
                    DataReceived = DataListener_StrBuilder.ToString();
                    //SentResponse(args.Socket.Information.RemoteHostName, "123", args.Socket.Information.RemotePort);
                    OnDataRecived(DataReceived);

                    //
                    DataWriter SentResponse_Writer = new DataWriter(args.Socket.OutputStream);
                    string content = "rECIEVED" + args.Socket.Information.RemoteAddress;
                    byte[] data = Encoding.UTF8.GetBytes(content);
                    // Write the bytes
                    SentResponse_Writer.WriteBytes(data);
                    // Store the written data
                    await SentResponse_Writer.StoreAsync();
                    SentResponse_Writer.DetachStream();  // note sure if this closed the start functioin
                }

            }
            catch (Exception ex)
            {
                if (OnError != null)
                    OnError(ex.Message);
            }
        }

Main IBackground Run
Code:

public sealed class StartupTask : IBackgroundTask

    {
        BackgroundTaskDeferral _deferral;
        private GpioPinValue pinValue;
        private GpioPinValue pinValueStatus;
        private const int LED_PIN = 5;
        private GpioPin pin;

        public void Run(IBackgroundTaskInstance taskInstance)
        {
            _deferral = taskInstance.GetDeferral();
            var socket = new SocketServer();

       


            ThreadPool.RunAsync(x =>
          {
              socket.OnError += socket_OnError;
              socket.OnDataRecived += Socket_OnDataRecived;
              socket.Start();
            }
                );


          private void Socket_OnDataRecived(string data)
        {
//do stuff with data
}

        }

ADO redistribution recomendations

$
0
0
Hello Group

I am referencing msado15.dll in my project in order to use ADODB.Connection hooked to a mySQl database.

very green at this but I had to install mysql-connector-odbc-3.51.30-win32 to get this working.

My users are the general public and I cannot ask them to do a separate install.

can someone recommend a way to get the supporting files installed using INNO setup, without using the mysql-connector-odbc-3.51.30-win32

Thanks
Happy Thanksgiving everyone.

Access connection is failing because of the file .ldb

$
0
0
Hello, I'm having a problem when I'm updating information in an Access file. I have an MS Excel with macros that open many other excels to obtain information to construct a sql statement. I have to insert that information on a table in access. It worked really well at the beginning. Nevertheless, when I want to use it several times, to test the macros, I got errors.

This is my sub:

Sub writeData(reportYear As Integer, state As String, school As String, campus As String, dataLabel As String, dataValue As Long)

Dim cn As New ADODB.Connection
Dim sql As String

' open a connection to the university crime database
cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.path & "\universityCrime.mdb" & ";Mode=Share Deny None;Persist Security Info=False;"

sql = "insert into crimedata(reportYear, state, school, campus, dataLabel, dataValue)" & _
"values(" & reportYear & ",'" & state & "','<~UNIV~>',NULL,'" & dataLabel & "'," & dataValue & ")"
sql = Replace(sql, "<~UNIV~>", Replace(school, "'", "''"))
If campus <> "NULL" Then
sql = Replace(sql, "NULL", "'" & Replace(campus, "'", "''") & "'")
End If

cn.Execute sql

cn.Close

End Sub

At the beginning I was using the ADODB.Connection:

cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.path & "\universityCrime.mdb" & ";"

It worked well. However, after some updates, I got the error:
Run-time error '-2147467259 (80004005)': Operation must use an updateable query

Reading on forums, I read that I need to force to avoid the read, so I changed the ADODB.Connection. Thus, my ADODB.Connection is as shown before.

Now, after many updates, I got the error:
Run-time error '-2147467259 (80004005)': The Microsoft Access database engine cannot open or write to the file 'C:\...\universityCrime.ldb'. It is already opened exclusively by another user, or ou need permission to view and write its data.

Thus, for my understanding, the code is correct. Nevertheless, the access connection stays open at some point, so it generates errors the next time that it is open. How can I solve this prolem? Should I force it to close? How can I do that?

Thanks in advance!

Compare two files

$
0
0
Hey.

On which way i can get two files compared.

Example. One file is distributed to client and i saved the original . After few days client return me the file i sent. I want to compare that file with my original file and see is there any differences.

The files are usually in .doc format . Also by getting files compared i only need to compare the content does it changed or not. I dontcare about tag/properties "Date modified" "User"...

Also i would love to see the changed content and is it possible to preview it without office ( not mandatory )..

Basically i would love to open copied file with highlighted changed lines.

Most examples i found on net are by comparing two .txt files by using stream writer so i dont have anything to show

[VB6] ActiveX VBFlexGrid (Replacement of the MSFlexGrid control)

$
0
0
This is the ActiveX Control version that comes out of the Std-EXE version.

Current version: 1.0.0

The development state of the ActiveX Control version does not necessarily match to the Std-EXE version.
That comes because the Std-EXE version is the "leading source" and the ActiveX Control version is derived from the Std-EXE version after a certain time.
Reason why is that it is not practicable to release a new ActiveX Control after each new feature.
However, certain bugfixes can and will be implemented into the current ActiveX Control version. (Revision)

It is not recommended to use the source code to compile another binary.
If own modification is necessary please rename the library to avoid redundancies.
The source code of the project can also be viewed on GitHub.

All controls are marked as "Safe for Initialization and Scripting" by the IObjectSafety interface.

Also everything is 100% IDE-Safe.

Here is a solution to use the VBFLXGRD10.OCX Registration-Free. (Side-by-side)
Keep in mind that this technology needs at minimum Windows XP SP2 or Windows Server 2003.

Tutorial:
The "Development" machine needs to register the VBFLXGRD10.OCX as usual and use the components for e.g. in a Std-EXE project.
The source project needs to include the Side-by-side resources. (see below)
Then on the "End user" machine you only need the VBFLXGRD10.OCX and the .exe (Std-EXE project) on the same folder.
It will work then without any registration.

The source code of "VBFLXGRD10SideBySide.res" is:

Code:

<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
<assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0">
  <file name="VBFLXGRD10.OCX">
      <typelib tlbid="{F6375E4B-F242-4215-9DE7-94FF9F9AC599}" version="1.0" flags="control" helpdir="" />
      <comClass clsid="{47C04A76-B660-4A47-B7A6-B40348DAE67F}" tlbid="{F6375E4B-F242-4215-9DE7-94FF9F9AC599}" threadingModel="Apartment" progid="VBFLXGRD.VBFlexGrid" />
      <comClass clsid="{3ADFCC8E-C7A5-4833-B699-4B9340937918}" tlbid="{F6375E4B-F242-4215-9DE7-94FF9F9AC599}" threadingModel="Apartment" />
      <comClass clsid="{785EFC34-6CC2-4F5E-B454-D2DDDECE5368}" tlbid="{F6375E4B-F242-4215-9DE7-94FF9F9AC599}" threadingModel="Apartment" />
  </file>
</assembly>


[VB6] Registry Hives Enumerator

$
0
0
This is very specific, but maybe will be useful for some registry guy :)

In short:

if you need to build a ton of nested loops for:

just say, you have a task to enumerate:

1) several keys
2) in the same location of HKLM / HKCU / HKU + every SID
3) separately consider WOW6432Node (read value with KEY_WOW64_64KEY flag and without) + exclude one of 'shared' keys (keys that point to the same phisical location in both 64/32-bit modes).

you can fit all in 1 single cycle with this 'Hives Enumerator' class.

Example:

Here is your old code:
Code:


    sRegRuns(1) = "Software\Microsoft\Windows\CurrentVersion\Run"
    sDes(1) = "Run"

    sRegRuns(2) = "Software\Microsoft\Windows\CurrentVersion\RunServices"
    sDes(2) = "RunServices"

        '...

    For i = 0 To UBound(aHives) 'HKLM, HKCU, HKU()

        For Each UseWow In Array(False, True)

            If (bIsWin32 And UseWow) _
              Or bIsWin64 And UseWow And _
              (sHive = "HKCU" _
              Or StrBeginWith(sHive, "HKU\")) Then Exit For

            For K = LBound(sRegRuns) To UBound(sRegRuns)

Here is how it looks now with my class:

Code:


    Dim HE as clsHiveEnum
    Set HE = New clsHiveEnum
    '...

    sRegRuns(1) = "Software\Microsoft\Windows\CurrentVersion\Run"
    sDes(1) = "Run"

    sRegRuns(2) = "Software\Microsoft\Windows\CurrentVersion\RunServices"
    sDes(2) = "RunServices"

    '...

    HE.Init HE_HIVE_ALL, HE_SID_ALL, HE_REDIR_BOTH
    HE.AddKeys sRegRuns

    Do While HE.MoveNext

        'that's all :) Just use HE.Hive, HE.Key, HE.Redirected and many more...
    Loop

Or you can enum hives without keys. Just don't use HE.AddKeys.

Required:
Some enums to Global module: just to support quick IntelliSense tips.

Dependencies:
modRegVirtualType.bas (included)

Good luck :)
-----------------


Live example (attached as demo):

Code:


    Dim HE As clsHiveEnum
    Set HE = New clsHiveEnum

    Dim aKey(1) As String

    aKey(0) = "HKLM\Software\Classes\AppID"
    aKey(1) = "Software\Classes\CLSID"

    HE.Init HE_HIVE_HKLM Or HE_HIVE_HKU, HE_SID_ALL, HE_REDIR_BOTH

    HE.AddKeys aKey

    Do While HE.MoveNext
        Debug.Print " --------- "
        Debug.Print "Hive handle: " & HE.Hive
        Debug.Print "Hive name:  " & HE.HiveName
        Debug.Print "Hive + key:  " & HE.KeyAndHive
        Debug.Print "Key:        " & HE.Key
        Debug.Print "Redirected:  " & HE.Redirected
        Debug.Print "Array index: " & HE.KeyIndex
        Debug.Print "User name:  " & HE.UserName
    Loop

    Set HE = Nothing

Result:
Quote:

---------
Hive handle: -2147483646
Hive name: HKLM
Hive + key: HKLM\Software\Classes\AppID
Key: Software\Classes\AppID
Redirected: False
Array index: 0
User name: All users
---------
Hive handle: -2147483646
Hive name: HKLM
Hive + key: HKLM\Software\Classes\CLSID
Key: Software\Classes\CLSID
Redirected: True
Array index: 1
User name: All users
---------
Hive handle: -2147483646
Hive name: HKLM
Hive + key: HKLM\Software\Classes\CLSID
Key: Software\Classes\CLSID
Redirected: False
Array index: 1
User name: All users
---------
Hive handle: -2147483645
Hive name: HKU
Hive + key: HKU\.DEFAULT\Software\Classes\CLSID
Key: .DEFAULT\Software\Classes\CLSID
Redirected: False
Array index: 1
User name: Default user
---------
Hive handle: -2147483645
Hive name: HKU
Hive + key: HKU\S-1-5-19\Software\Classes\CLSID
Key: S-1-5-19\Software\Classes\CLSID
Redirected: True
Array index: 1
User name: Local service
---------
Hive handle: -2147483645
Hive name: HKU
Hive + key: HKU\S-1-5-19\Software\Classes\CLSID
Key: S-1-5-19\Software\Classes\CLSID
Redirected: False
Array index: 1
User name: Local service
---------
Hive handle: -2147483645
Hive name: HKU
Hive + key: HKU\S-1-5-20\Software\Classes\CLSID
Key: S-1-5-20\Software\Classes\CLSID
Redirected: True
Array index: 1
User name: Network service
---------
Hive handle: -2147483645
Hive name: HKU
Hive + key: HKU\S-1-5-20\Software\Classes\CLSID
Key: S-1-5-20\Software\Classes\CLSID
Redirected: False
Array index: 1
User name: Network service
Above, we requested:
1) for HE_HIVE_HKLM + HE_HIVE_HKU hives.
2) aKey(0) have exception: list HKLM only (see prefix "HKLM\...")
3) HE_SID_ALL
4) WOW + no WOW

We got:
1) only 1 iteration of aKey(0) -> HKLM\Software\Classes\AppID, because it is 'Shared' key. WOW mode is point to the same phisical location, so WOW iteration is skipped.
2) 2 iteration of aKey(1) of HKLM. 1 - WOW, 2 - No WOW.
3) 5 iterations of aKey(1) of HKU. 1 - .Default SID, 2 - S-1-5-19, 3 - S-1-5-20, where:
- HKU\.Default\Software\Classes\CLSID is not 'redirected' key, that's why only 1 iteration
- S-1-5-19 and S-1-5-20 ARE 'redirected' keys, that's why +2 iterations for each (WOW, no WOW)

Note: that class doesn't check and skip keys that are not exist (it is responsibility of caller).
E.g. if I'll create:
- HKEY_USERS\S-1-5-19\Software\Classes\Wow6432Node\CLSID
and remove:
- HKEY_USERS\S-1-5-19\Software\Classes\CLSID
class will produce 2 iterations (with .Redirected = 'true', and with 'false').

-----------------------------------

Detailed description of the class:

Common scheme of the cycle:
Code:

' {
'  1. Keys (if supplied)
'  {
'    2. HKLM / HKCU / HKU + every SID...
'    {
'      3. REDIR_WOW (redirected) / REDIR_NO_WOW
'    }
'  }
' }

Stages of using:

I. Required initialization:

Set global rule for iterator:
Code:

HE.Init [Hives], [opt_SIDs], [opt_WOW_Modes]
where every arg. is a sum of bits, available from Intellisense, e.g.:
Code:

HE.Init HE_HIVE_HKLM Or HE_HIVE_HKCU
[Hives]

Code:

    HE_HIVE_ALL - all
    HE_HIVE_HKLM - HKLM only
    HE_HIVE_HKCU - HKCU only
    HE_HIVE_HKU - HKU only

What properties are affected:
- .Hive
- .HiveName
- .HiveNameAndSID
- .KeyAndHive
- .UserName

[SIDs]
Code:

    HE_SID_ALL - all
    HE_SID_DEFAULT - HKU\.Default (target of HKU\S-1-5-18 symlink)
    HE_SID_SERVICE - mean HKU\S-1-5-19 (Local service) and HKU\S-1-5-20 (Network service)
    HE_SID_USER - mean other currently logged users, excepting current user (available as HKCU)

What properties are affected:
- .HiveNameAndSID
- .KeyAndHive
- .UserName
- .IsSidSystem
- .IsSidUser
- .IsSidDefault properties.

[WOW_Modes]
Code:

    HE_REDIR_BOTH - to iterate both WOW modes (checking for 'Shared' keys will be activated for this flag only)
    HE_REDIR_NO_WOW - NO_WOW only (64-bit keys)
    HE_REDIR_WOW - WOW only (32-bit keys)
    HE_REDIR_DONT_IGNORE_SHARED - ignore checking for 'Shared' type. Force iteratation of every WOW mode.

What properties are affected:
- .Redirected

2. Optional. Supply key (keys).

a) Supply array of keys:
Code:

HE.AddKeys string_array
What properties are affected:
- .Key
- .KeyAndHive
- .SharedKey
- .KeyIndex

b) Supply single key (or keys one by one with several .AddKey calls)

What properties are affected:
- .Key
- .KeyAndHive
- .SharedKey
- special excludes for hives.
Code:

HE.AddKey [Key], [opt_PostPlaceholder]
where:
[Key] is a key in any of 2 formats:
1) Key
2) Hive\Key

It's can be:
Quote:

Software\Classes\CLSID
HKLM\Software\Classes\AppID
HKEY_LOCAL_MACHINE\Software\Classes\AppID
In case, you prepended concrete "Hive" to key it will be treated as an exclude from global rule (e.g., HE.Init HE_HIVE_ALL): for such key, enumerator will return only concrete hive (HKLM in example above).

[opt_PostPlaceholder] - optional. Any text. Enumerator will append it to the .Key. You can use it in your cycle e.g., to replace with a data that was not known to you at the time of class initialization (e.g. to replace manually "{CLSID}" by real CLSID in different parts of key for different keys).


II. Beginning of enumeration.

Code:

Do while HE.MoveNext
        'use any HE property
Loop


III. Using of properties.

HE.Hive - hive handle (constant)
HE.Key - string, representing the key only, e.g. 'Software\Microsoft'
HE.Redirection - boolean, representing WOW mode (false - native key, true - 32-bit key).
HE.KeyAndHive - string, "Hive\Key"
HE.HiveName - string, short name of hive, e.g. "HKLM"
HE.HiveNameAndSID - string, e.g. "HKU\S-1-5-19"
HE.UserName - string:
- for HKLM - "All users"
- for HKCU - current user's name
- for HKU\S-1-5-19 - "Local service"
- for HKU\S-1-5-20 - "Network service"
- for HKU\.Default - "Default user"
- for HKU\S-some another SID - user's name of that SID
HE.KeyIndex - index of array passed to the class used in current iteration, e.g. need, if you track several linked arrays by its index, like array of keys + array of these keys' description and want to get description by index for current iteration (see first example above - for sDes() array it will be sDes(HE.KeyIndex) ).
HE.SharedKey - boolean. To know if this key have a 'shared' type, e.g. need, if you know that this key1 linked to another key2, so if key1 is 'Shared' and key2 is not, now you know e.g. that you need to pay attention on both WOW modes of key2.
HE.IsSidService - boolean. TRUE, if current iteration is on 'HKU\S-1-5-19' or, 'HKU\S-1-5-20'
HE.IsSidUser - boolean. TRUE, if current iteration is on 'HKU\S-Some custom logged user'
HE.IsSidDefault - boolean. TRUE, if current iteration is on 'HKU\.Default'

Methods:

PrintAll - test reason. To show in debug. window all properties of all iterations. Try play with it :)


IV. Optional steps.

Repeat enum.

If you need repeat enumeration again with the same settings:
Code:

HE.Repeat

Do While HE.MoveNext
'...


Erase / fresh enum:

Just use .Init again with the same or new settings.
It will erase all data supplied before. No need to terminate the class.
Attached Files

Call a sub on another form in classLiblary project.

$
0
0
Hallo,
I have a solution with multiple-project, and i have a master form called master_ChartofAccount, and on coa_Create after save the data, i want to call a sub named showCoa to refresh a grid on coa_Create, here's my code :

Code:

Public Class master_ChartofAccount
    Inherits MetroForm

    Private Sub master_ChartofAccount_Load(sender As Object, e As EventArgs) Handles Me.Load
        showCoa()
    End Sub

    Sub showCoa()
        mGrid.Tag = "Select id, coa_code as 'Kode', coa_name as 'Nama Akun', case when db_cr = 'dr' then" _
            & "'Debet' else 'Kredit' end as 'Dr/cr', bs_is as 'BS/IS', p_code, is_parent from " _
            & "t_chart_of_account where coa_name like '%" & objComp.clearSingleQuote(txtFind.Text) & "%' order by coa_code"
        objComp.setDataGrid(mGrid.Tag, mGrid)

        mGrid.Columns(0).Visible = False
        mGrid.Columns(mGrid.ColumnCount - 1).Visible = False
        mGrid.Columns(mGrid.ColumnCount - 2).Visible = False

        objComp.setColWidth(2, mGrid)

    End Sub

    Private Sub cmdClose_Click(sender As Object, e As EventArgs) Handles cmdClose.Click
        Me.Close()
    End Sub

    Private Sub cmdDisplay_Click(sender As Object, e As EventArgs) Handles cmdDisplay.Click
        showCoa()
    End Sub

    Private Sub txtFind_Click(sender As Object, e As EventArgs) Handles txtFind.Click

    End Sub

    Private Sub txtFind_KeyPress(sender As Object, e As KeyPressEventArgs) Handles txtFind.KeyPress
        If e.KeyChar = Chr(Keys.Enter) Or e.KeyChar = Chr(Keys.Return) Then showCoa()
    End Sub

    Private Sub cmdAdd_Click(sender As Object, e As EventArgs) Handles cmdAdd.Click
        Dim frm As New coa_Create
        frm.ShowDialog(Me)
    End Sub

    Private Sub mGrid_DoubleClick(sender As Object, e As EventArgs) Handles mGrid.DoubleClick
        cmdEdit_Click(sender, e)
    End Sub

    Private Sub cmdEdit_Click(sender As Object, e As EventArgs) Handles cmdEdit.Click
        If mGrid.CurrentCell Is Nothing Then Exit Sub
        Using frm As New coa_Create
            With frm
                .Text = "Edit Chart of Account"
                .txtKode.Tag = mGrid.CurrentRow.Cells(0).Value
                .txtKode.Text = mGrid.CurrentRow.Cells(1).Value
                .txtNama.Text = mGrid.CurrentRow.Cells(2).Value
                .optDb.Checked = IIf(mGrid.CurrentRow.Cells(3).Value = "Debet", True, False)
                .optCr.Checked = IIf(mGrid.CurrentRow.Cells(3).Value = "Kredit", True, False)
                .optBS.Checked = IIf(mGrid.CurrentRow.Cells(4).Value = "BS", True, False)
                .optIS.Checked = IIf(mGrid.CurrentRow.Cells(4).Value = "IS", True, False)
                .txtParentCode.Text = mGrid.CurrentRow.Cells(5).Value.ToString
                .txtParentName.Text = objComp.setLookUpTable("t_chart_of_account", "coa_name",
                                                            "coa_code= '" & .txtParentCode.Text & "'")
                .chkParent.Checked = mGrid.CurrentRow.Cells(6).Value
                .ShowDialog(Me)
            End With
        End Using
    End Sub
End Class

and here's cmdSave code on coa_Create :
Code:

Private Sub cmdSave_Click(sender As Object, e As EventArgs) Handles cmdSave.Click
        If Not allowSave() Then Exit Sub
        Dim str As String
        txtKode.Tag = IIf(IsNothing(txtKode.Tag), "", txtKode.Tag)

        If txtKode.Tag.ToString = "" Then
            str = "insert into t_chart_of_account (coa_code, coa_name, p_code, is_parent, db_cr, bs_is) " _
                & "values ('" & objComp.clearSingleQuote(txtKode.Text) & "', '" & objComp.clearSingleQuote(txtNama.Text) & "', " _
                & "'" & objComp.clearSingleQuote(txtParentCode.Text) & "', " & IIf(chkParent.Checked = True, 1, 0) & ", " _
                & "'" & IIf(optDb.Checked = True, "DR", "CR") & "', '" & IIf(optBS.Checked = True, "BS", "IS") & "')"
        Else
            str = "update t_chart_of_account set coa_code = '" & txtKode.Text & "', " _
              & "coa_name = '" & objComp.clearSingleQuote(txtNama.Text) & "', p_code = '" & txtParentCode.Text & "', " _
              & "is_parent = " & IIf(chkParent.Checked = True, 1, 0) & ", db_cr = '" & IIf(optDb.Checked = True, "DR", "CR") & "', " _
              & "bs_is = '" & IIf(optBS.Checked = True, "BS", "IS") & "' WHERE id = " & txtKode.Tag.ToString
        End If
        objComp.setExecute(str, False)

master_ChartofAccount.showCoa() 'error on this line : Reference to a non-shared member requires an object reference

        objComp.msgShow(Me, "Data berhasil di simpan.", "Simpan Berhasil", MessageBoxButtons.OK, MessageBoxIcon.Information)
        cmdClose_Click(sender, e)
    End Sub

why there's an error msg : Reference to a non-shared member requires an object reference on
Code:

master_ChartofAccount.showCoa()
how to fix this ?
is there other way to call a sub from another form ?

Thanks

What is the "Variant" data type structure of VB6?

$
0
0
VB6 has a variable type named "Variant"
but what is the real memory structure of it?
can anyone help me please? thanks in advance...

VB6 Work

$
0
0
Hello. I am an independent programmer who has been operating primarily as a one-man company for the last 8+ years. I am looking to expand, or at least maintain a fairly robust roster of clientele, and I have been doing a juggling act all this time in keeping up with the workload. Recently I have come across a number of opportunities to maintain VB6 projects (varied industries) and it would be desirable to have a "right-hand man/woman" interested in working steadily on these for projects for me. Number of hours per week as well as hourly rate are open for discussion. If interested, please respond here or PM me.

*** NOTE: Please view this post independent from the post I made earlier regarding a VB4 project to monitor animal's physiological processes. That is a specialized application and I am dealing with that separately, and will likely work with a different programmer on that one. The projects I am referring to in this post are more general in nature (client/server variety). ***

Serialization

$
0
0
It is fairly easy to Serialize objects in Visual Basic.
What is serialization for?

Code:

Public Class Data

    Public Shared Sub Save(Path As String, Data As Type)
        Dim BF As New Runtime.Serialization.Formatters.Binary.BinaryFormatter()
        Using S As New IO.FileStream(Path, IO.FileMode.OpenOrCreate, IO.FileAccess.Write)
            BF.Serialize(S, Data)
        End Using
    End Sub

    Public Shared Function Load(Path As String) As Type
        Dim BF As New Runtime.Serialization.Formatters.Binary.BinaryFormatter()
        Using S As New IO.FileStream(Path, IO.FileMode.OpenOrCreate, IO.FileAccess.Read)
            Try
                Return CType(BF.Deserialize(S), Type)
            Catch ex As Exception
                ' File not found/cannot be read.
                Return Nothing
            End Try
        End Using
    End Function

End Class

Don't forget to add the serializable attribute on the class you wish to serialize.

Code:

<Serializable()>
Public Class SomeType
    ' Properties...
End Class

Best of luck,
NinjaNic
Viewing all 42083 articles
Browse latest View live


<script src="https://jsc.adskeeper.com/r/s/rssing.com.1596347.js" async> </script>