Come controllare la porta parallela da qualunque sistema Operativo

BOOL CPort::GetOpSystem()
{
	OSVERSIONINFO *osvi;
	osvi = new(OSVERSIONINFO);
	osvi->dwOSVersionInfoSize=sizeof(OSVERSIONINFO) ;
	GetVersionEx (osvi);
	bIsWindowsNTorLater = (osvi->dwPlatformId == VER_PLATFORM_WIN32_NT );
	try {delete osvi;}
	catch(...){;};
	return bIsWindowsNTorLater;
}

unsigned char CPort::inport(unsigned short PortAddress)
{
    if (!bIsWindowsNTorLater)
	{
		return _inp(PortAddress);
	};

	unsigned int error;
    DWORD BytesReturned;
    unsigned char Buffer[3];
    unsigned short * pBuffer;
    pBuffer = (unsigned short *)&Buffer;
    *pBuffer = PortAddress;

    error = DeviceIoControl(PortTalk_Handle,
                            IOCTL_READ_PORT_UCHAR,
                            &Buffer,
                            2,
                            &Buffer,
                            1,
                            &BytesReturned,
                            NULL);

    if (!error)
		AfxMessageBox("Errore di comunicazione con il driver",MB_OK,0);
    return(Buffer[0]);

}


void CPort::outport(unsigned short PortAddress, unsigned char byte)
{
	if (!bIsWindowsNTorLater)
	{
		_outp(PortAddress,byte);
		return;
	};

    unsigned int error;
    DWORD BytesReturned;        
    unsigned char Buffer[3];
    unsigned short * pBuffer;
    pBuffer = (unsigned short *)&Buffer[0];
    *pBuffer = PortAddress;
    Buffer[2] = byte;

    error = DeviceIoControl(PortTalk_Handle,
                            IOCTL_WRITE_PORT_UCHAR,
                            &Buffer,
                            3,
                            NULL,
                            0,
                            &BytesReturned,
                            NULL);

    if (!error) 
		AfxMessageBox("Errore di comunicazione con il driver",MB_OK,0);
}

Come sospendere l'esecuzione di un programma

#include 
#include 

/*funzione pausa*/
void pausa(double sec)
{
   clock_t t = (clock_t)(clock() + (CLOCKS_PER_SEC * sec));

   while (clock() < t)
      ;
   return;
}

/*Esempio di utilizzo :
stampa la stringa puntata da s con effetto "macchina da scrivere" */

int main(void)
{
   char *s = "Raffaele Pizzolante";

   for ( ; *s; s++) {
      cout << *s;
      pausa(1.0 / 5.0); /*1/5 di secondo*/
   }
   return 0;
}

Come monitorare i processi di Windows

Convertire un filmato flash in EXE

function Swf2Exe(S, D, F: string): string;
var
 SourceStream, DestinyStream, LinkStream: TFileStream;
 flag: Cardinal;
 SwfFileSize: integer;
begin
 result := 'something error';
 DestinyStream := TFileStream.Create(D, fmCreate);
 try
   LinkStream := TFileStream.Create(F, fmOpenRead or fmShareExclusive);
   try
     DestinyStream.CopyFrom(LinkStream, 0);
   finally
     LinkStream.Free;
   end;

   SourceStream := TFileStream.Create(S, fmOpenRead or fmShareExclusive);
   try
     DestinyStream.CopyFrom(SourceStream, 0);
     flag := $FA123456;
     DestinyStream.WriteBuffer(flag, sizeof(integer));
     SwfFileSize := SourceStream.Size;
     DestinyStream.WriteBuffer(SwfFileSize, sizeof(integer));
     result := '';
   finally
     SourceStream.Free;
   end;
 finally
   DestinyStream.Free;
 end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
 Swf2Exe('c:\prova.swf', 'c:\provai.exe', 'D:\FlashPla.exe');
end;

Come creare una directory

      StringTokenizer tokenDirectory = new StringTokenizer(percorsoCompleto, "\\");
      StringBuffer stringaSottoDirectory = new StringBuffer("");
      while(tokenDirectory.hasMoreElements())
      {
        stringaSottoDirectory.append(tokenDirectory.nextToken()).append("\\");
        File sottoDirectory = new File(stringaSottoDirectory.toString());
        if(!sottoDirectory.exists())
        {
            sottoDirectory.mkdir();
        }
     }

Come "ricercare" una finestra tra quelle aperte in Windows

Option explicit

Private Declare Function GetWindow Lib "user32" Alias "GetWindow" (ByVal hwnd As Long, 
ByVal wCmd As Long) As Long
Public Declare Function GetDesktopWindow Lib "user32" () As Long
Public Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As String) As Long
Public Declare Function GetWindowTextLength Lib "user32" Alias 
"GetWindowTextLengthA" (ByVal hWnd As Long) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As 
Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hwnd As 
Long, ByVal lpString As String) As Long

Private Const GW_CHILD = 5
Private Const GW_HWNDNEXT = 2

Public Function SearchWindow(hWnd As Long, sCaption As String) As Long
On Local Error Resume Next
Dim H1 As Long, T As String, T23 As String
 
 H1 = GetWindow(hWnd, GW_CHILD)
 If H1 = 0 Then Exit Function
 T = FindWindowsText(H1)

 If T = sCaption Then
    SearchWindow = H1: Exit Function
 End If
 
 If GetWindow(H1, GW_CHILD) > 0 Then
   SearchWindow = SearchWindow(H1, sCaption)
   If SearchWindow <> 0 Then Exit Function
 End If
 
    Do
     H1 = GetWindow(H1, GW_HWNDNEXT)
     If H1 = 0 Then Exit Function
     T = FindWindowsText(H1)
     If T = sCaption Then
        SearchWindow = H1: Exit Function
     End If
        If GetWindow(H1, GW_CHILD) > 0 Then
            SearchWindow = SearchWindow(H1, sCaption)
            If SearchWindow <> 0 Then Exit Function
        End If
    Loop Until H1 = 0
End Function

Public Function FindWindowsText(hWnd As Long) As String
    FindWindowsText = String$(GetWindowTextLength(hWnd) + 1, vbNull)
    GetWindowText hWnd, FindWindowsText, Len(FindWindowsText)
    FindWindowsText = Left(FindWindowsText, lstrlen(FindWindowsText))
End Function

Public Function ChangeWindowsCaption (hWnd As Long,sTxt As String)
SetWindowText hWnd, sTxt
End Function

Un conto alla rovescia per arrestare il sistema

Private Sub Timer_tempo_Timer()
If lblTempos.Caption = 0 And lblTempom.Caption = 0 And lblTempoh.Caption = 0 Then
   Timer_tempo.Enabled = False
Else
   lblTempos.Caption = lblTempos.Caption - 1
End If

If lblTempos.Caption < 0 Then
   lblTempom.Caption = lblTempom.Caption - 1
   lblTempos.Caption = 59
End If

If lblTempom.Caption < 0 Then
   lblTempoh.Caption = lblTempoh.Caption - 1
   lblTempom.Caption = 59
End If

If lblTempoh.Caption < 0 Then
   lblTempoh.Caption = 0
   lblTempom.Caption = 59
End If

If lblTempoh.Caption = 0 Then
   lblTempoh.Caption = 0
End If

If lblTempos.Caption = 0 Then
   If lblTempom.Caption = 0 Then
      If lblTempoh.Caption = 0 Then
         Timer_tempo.Enabled = False
         Form1.Show
		 MsgBox "Tempo scaduto!", vbOKOnly + vbExclamation, "Arresto sistema in corsoà"
		 ' per Windows 98
		 Shell ("C:\WINDOWS\RUNDLL.EXE user.exe,exitwindows")
		 'per Windows XP
		 Shell ("C:\WINDOWS\RUNDLL32.EXE user,exitwindows")
	  	 End
   	  End If
   End If
End If
End Sub

Private Sub Timer_controllo_Timer()
   If lblTempos.Caption = 0 And lblTempom.Caption = 0 And lblTempoh.Caption = 0 Then
      cmdAccendi.Enabled = False
   Else
      If Timer_tempo.Enabled = False Then
         cmdAccendi.Enabled = True
	  End If
   End If
End Sub

'codice dei vari CommandButton
Private Sub cmdAccendi_Click()
	Timer_tempo.Enabled = True
	cmdAccendi.Enabled = False
End Sub

Private Sub cmdStop_Click()
	Timer_tempo.Enabled = False
	If lblTempoh.Caption = 0 And lblTempom.Caption = 0 And lblTempos.Caption = 0 Then
		cmdAccendi.Enabled = False
	Else
		cmdAccendi.Enabled = True
	End If
End Sub

Private Sub cmdImpostaTime_Click()
	If Timer_tempo.Enabled = False Then
		cmdAccendi.Enabled = False
	End If

	If txtOra.Text > "24" Then
		MsgBox "Il Timer dell'ora non Φ accettabile", vbOKOnly + vbCritical, "Errore MB 
		TimeOut! 1.0"
		txtOra.Text = ""
		txtOra.SetFocus
	Else
		lblTempoh.Caption = txtOra.Text
	End If

	If txtMinuti.Text > "59" Then
		MsgBox "Il Timer dei minuti non Φ accettabile", vbOKOnly + vbCritical, "Errore MB 
		TimeOut! 1.0"
		txtMinuti.Text = ""
		txtMinuti.SetFocus
	Else
		lblTempom.Caption = txtMinuti.Text
	End If

	If txtSecondi.Text > "59" Then
		MsgBox "Il Timer dei secondi non Φ accettabile", vbOKOnly + vbCritical, "Errore MB 
		TimeOut! 1.0"
		txtSecondi.Text = ""
		txtSecondi.SetFocus
	Else
		lblTempos.Caption = txtSecondi.Text
	End If

	If txtOra.Text = "" Then
		lblTempoh.Caption = 0
	End If

	If txtMinuti.Text = "" Then
		lblTempom.Caption = 0
	End If
	If txtSecondi.Text = "" Then
		lblTempos.Caption = 0
	End If
End Sub

Private Sub optImpostazioni_Click()
	txtOra.Enabled = False
	txtMinuti.Enabled = False
	txtSecondi.Enabled = False
	cmdImpostaTime.Enabled = False
	cmdStop.Enabled = False
End Sub

Private Sub Form_Unload(Cancel As Integer)
	MsgBox "Chiusura non consentita", vbOKOnly + vbCritical, "Arresto sistema in corso..."
	' per Windows 98
	Shell ("C:\WINDOWS\RUNDLL.EXE user.exe,exitwindows")
	'per Windows XP
	Shell ("C:\WINDOWS\RUNDLL32.EXE user,exitwindows")
	End
End Sub

Come copiare una lista di IP in un vettore

Private Sub Command1_Click()
    
    Dim temp() As String
    Dim ip()
    Dim port()
    Dim fine As Integer
    Dim i, j As Integer
    
    temp = Split(txtIP.Text, vbCrLf)
    j = -1
    
    For i = LBound(temp) To UBound(temp)
        fine = InStr(1, temp(i), ":")
        If ((fine > 7) And (fine < 17)) Then
            j = j + 1
            ReDim Preserve ip(j)
            ReDim Preserve port(j)
            
            ip(i) = Mid(temp(i), 1, fine - 1)
            port(i) = Mid(temp(i), fine + 1, Len(temp(i)))
        End If
    Next i
End Sub

Un semplice Server proxy

Option Explicit
Dim i As Integer

Private Sub delay(interval As Single)
	Dim s As Single
	s = Timer
	Do While Timer < (s + interval)
	    DoEvents
	Loop
End Sub

Private Sub parse(buffer As String, ByRef server As String, ByRef richiesta As String)
	On Error Resume Next
	Dim url As String
	url = Left$(buffer, InStr(buffer, "HTTP/1.1") - 2)
	url = Right$(url, Len(url) - 5)
	If InStr(url, "/") = 0 Then
 	   server = url
	    richiesta = "GET /"
	Else
	    server = Left$(url, InStr(url, "/") - 1)
	    richiesta = "GET " & Right$(url, Len(url) - Len(server)) & vbCrLf
	End If
End Sub

Private Sub Form_Load()
	wskserver.LocalPort = 8080
	wskserver.Listen
	i = 0
End Sub

Private Sub wskconnect_DataArrival(Index As Integer, ByVal bytesTotal As Long)
	On Error Resume Next
	Dim buffer As String
	Dim server As String
	Dim richiesta As String
	wskconnect(Index).GetData buffer
	parse buffer, server, richiesta
	Load wskweb(Index)
	wskweb(Index).Connect server, 80
	delay 1
	wskweb(Index).SendData richiesta
End Sub

Private Sub wskconnect_SendComplete(Index As Integer)
	wskconnect(Index).Close
	wskweb(Index).Close
	Unload wskconnect(Index)
	Unload wskweb(Index)
End Sub

Private Sub wskserver_ConnectionRequest(ByVal requestID As Long)
	i = i + 1
	Load wskconnect(i)
	wskconnect(i).Accept requestID
	delay 1
End Sub

Private Sub wskweb_DataArrival(Index As Integer, ByVal bytesTotal As Long)
	On Error Resume Next
	Dim risposta As String
	wskweb(Index).GetData risposta
	wskconnect(Index).SendData risposta
End Sub

Come calcolare il crc32 di alcune tipologie di dati

Option Explicit

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, 
Source As Any, ByVal Length As Long)

Private crc32table(255) As Long
Private Crc32TableSet As Boolean

Public Sub CreateTable(Optional lPolinomio As Long = &HEDB88320)
  Dim I     As Long
  Dim j     As Long
  Dim lCrc  As Long
  
  For I = 1 To 255 Step 1
    lCrc = I
    j = 8
    For j = 1 To 8 Step 1
      If (lCrc And 1) Then
        lCrc = ((lCrc And &HFFFFFFFE) \ 2&) And &H7FFFFFFF

        lCrc = lCrc Xor lPolinomio
      Else
        lCrc = ((lCrc And &HFFFFFFFE) \ 2&) And &H7FFFFFFF

      End If
    Next
    crc32table(I) = lCrc
Next I
Crc32TableSet = True
End Sub

Public Function CalcCRC32(ByteArr() As Byte) As Long
  Dim I As Long
  Dim CRC32Val As Long
  Dim ArrLen As Long
  Dim LongBytes(3) As Byte
  If (Not Crc32TableSet) Then CreateTable
  CRC32Val = -1
  ArrLen = UBound(ByteArr())
  For I = 0 To ArrLen Step 1
      SplitLongValues CRC32Val, LongBytes(): LongBytes(3) = 0
      CRC32Val = crc32table((CRC32Val Xor ByteArr(I)) And &HFF)
      CRC32Val = CRC32Val Xor MergeLongValues(LongBytes())
  Next
  
  CalcCRC32 = CRC32Val
End Function

Public Function CalcCRC32FromString(sStr As String) As Long
Dim bArr() As Byte, I As Long

    If Len(sStr) > 0 Then
        ReDim bArr(0 To (Len(sStr) - 1)) As Byte
        For I = 1 To Len(sStr) Step 1
            bArr(I - 1) = Asc(Mid(sStr, I, 1))
        Next
         CalcCRC32FromString = CalcCRC32(bArr())
    End If
    
End Function

Public Function CalcCRC32FromFile(sFile As String) As Long
On Local Error Resume Next
Dim bArr() As Byte, I As Long, L As Long
    If FileLen(sFile) > 0 Then
        If Err <> 0 Then Err = 0: Exit Function
        ReDim bArr(0 To (FileLen(sFile) - 1)) As Byte
        L = FreeFile()
        Open sFile For Binary As L
            Get L, , bArr()
        Close L
        CalcCRC32FromFile = CalcCRC32(bArr())
    End If
End Function

Public Sub SplitLongValues(lValue As Long, ByteArr() As Byte)
   CopyMemory ByteArr(0), lValue, 4
End Sub

Public Sub SplitIntegerValues(iValue As Integer, ByteArr() As Byte)
    CopyMemory ByteArr(0), lValue, 2
End Sub

Public Function MergeLongValues(ByteArr() As Byte) As Long
    CopyMemory MergeLongValues, ByteArr(0), 4
End Function

Public Function MergeIntegerValues(ByteArr() As Byte) As Integer
    CopyMemory MergeIntegerValues, ByteArr(0), 2
End Function