如何使用Shell='我的程序',后正常的返回Explorer桌面.高手请进! 问题已解决,再来几个人,好分分. (100分)

to beta
谢谢你的回答,这个问题不太容易解决,看一下ligia的.
http://www.iligia.com/chinese/program/xlogins.htm 这个须要 Money,肯定不会很简单.

你可以换个方式实现吗？
我是这样做的：
把自己的SHELL.exe放到C:/改名为EXPLORER.exe
重启后便会先运行你的程序了
在程序中调用SEHLLEXECUTE（handle,nil,'c:/windows/explorer.exe',nil,nil,sw_normal）
便会返回正常的DEAKTOP；
这时候你的程序可以退出也可以继续监听

to beamgx
谢谢你的回答,放在C:盘根目录太显眼了,放在别的地方不行吗.

正在试

up

我以前用vb写的，做参考吧，能够实现win9X的登陆，，至于你说的，你把程序放在c盘根目录
并把程序名写成Explorer.exe，启动的时候会运行你的程序，而不会运行真正的Explorer.exe
当你的用户名和密码验证通过的时候，那么更半真正的Explorer.exe shell出来，就可以了
在delphi中shell程序是winexec('ABCD.exe',sw_Show);
Option Explicit
Const SPI_SCREENSAVERRUNNING = 97
Private Declare Function SystemParametersInfo Lib "User32" Alias _
"SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, lpvParam As _
Any, ByVal fuWinIni As Long) As Long
Private Declare Function GetWindowsDirectoryA Lib "kernel32" _
(ByVal lpBuffer As String, ByVal nSize As Long) As Long
Public KeyAscii As Integer

Private Sub Decipher(ByVal password As String, ByVal from_text As String, to_text As String)
Const MIN_ASC = 32
Const MAX_ASC = 126
Const NUM_ASC = MAX_ASC - MIN_ASC + 1
Dim offset As Long
Dim str_len As Integer
Dim i As Integer
Dim ch As Integer
offset = NumericPassword(password)
Rnd -1 '------------------还原加密函数
Randomize offset
str_len = Len(from_text)
For i = 1 To str_len
ch = Asc(Mid$(from_text, i, 1))
If ch >= MIN_ASC And ch <= MAX_ASC Then
ch = ch - MIN_ASC
offset = Int((NUM_ASC + 1) * Rnd)
ch = ((ch - offset) Mod NUM_ASC)
If ch < 0 Then ch = ch + NUM_ASC
ch = ch + MIN_ASC
to_text = to_text & Chr$(ch)
End If
Next i
End Sub
Private Function NumericPassword(ByVal password As String) As Long
Dim value As Long
Dim ch As Long
Dim shift1 As Long
Dim shift2 As Long
Dim i As Integer
Dim str_len As Integer
str_len = Len(password)
For i = 1 To str_len
ch = Asc(Mid$(password, i, 1)) '---------------------------密码加密还原函数
value = value Xor (ch * 2 ^ shift1)
value = value Xor (ch * 2 ^ shift2)
shift1 = (shift1 + 7) Mod 19
shift2 = (shift2 + 13) Mod 23
Next i
NumericPassword = value
End Function

Public Function GetWindowsDirectory() As String
Dim s As String
Dim i As Integer
i = GetWindowsDirectoryA("", 0)
s = Space(i)
Call GetWindowsDirectoryA(s, i)
s = Left$(s, i - 1)
If Len(s) > 0 Then
If Right$(s, 1) <> "/" Then
GetWindowsDirectory = s + "/"
Else
GetWindowsDirectory = s
End If
Else
GetWindowsDirectory = "/"
End If
End Function
Private Sub Command1_Click()
On Error GoTo err1
Dim a As String
Dim b As String
Dim c As String
Dim d As String
Dim i As Integer
Dim zcm As String
Dim fstr1 As String
Dim fstr2 As String
Dim fstr3 As String
Dim fstr4 As String
Text1.PasswordChar = ""
If Command1.Caption = "确定输入" Then
zcm = Text1.Text
Else
a = Text1.Text
b = Text2.Text
If Text1.Text = "abcdefghijklm1nABC++" Then
For i = 1 To 3
Print
Next i
Text8.Text = GetSetting("myset", "settings", "username")
Decipher "qzw", Text8.Text, fstr3
Text8.Text = fstr3
Text9.Text = GetSetting("myset", "settings", "password")
Decipher "qzw", Text9.Text, fstr4
Text9.Text = fstr4
Print " " & "您要找的用户名是:" & Text8.Text & " " & "你要找的密码是:" & Text9.Text
End If
Text3.Text = GetSetting("myset", "settings", "username")
Decipher "qzw", Text3.Text, fstr1 '------------------------使加密字串还原
Text3.Text = fstr1 '把还原的字串给text3
Text4.Text = GetSetting("myset", "settings", "password")
Decipher "qzw", Text4.Text, fstr2 '------------------------使加密字串还原
Text4.Text = fstr2 '把还原的字串给text4
If Text1.Text <> Text3.Text Then
Text1.Text = "用户名错误!"
Text2.Text = ""
Else
If Text2.Text = Text4.Text Then
Unload Form2 '
Text6.Text = GetWindowsDirectory()
Text6.Text = Text6.Text & "explorer.exe"
Call Shell(Text6.Text)
Unload Form3
Unload Me
Dim pOld As Boolean
Call SystemParametersInfo(SPI_SCREENSAVERRUNNING, False, pOld, 0)
Else
Text1.Text = "密码错误!"
Text2.Text = ""
End If
End If
End If
Exit Sub
err1:
MsgBox "一个不知名错误!", vbOKOnly, "错误"
Exit Sub
End Sub
Private Sub Command2_Click()
Form2.Show
End Sub
Private Sub Command3_Click()
On Error GoTo err7
Label2.ForeColor = vbBlue
Label2.Caption = "广而告知"
Text5.Visible = True
Label1.Caption = "请输入注册码:"
Label1.ForeColor = vbRed
Text5.Text = "注册费仅为10元人民币，请大家支持个人软件的发展"
Text2.Enabled = False
Command3.Visible = False
Command6.Visible = True
Command4.Visible = True
Exit Sub
err7:
Exit Sub
End Sub
Private Sub Command4_Click()
On Error GoTo err8
Text5.Visible = False
Label2.ForeColor = vbBlack
Label2.Caption = "密码:"
Label1.Caption = "用户名:"
Label1.ForeColor = vbBlack
Text2.Enabled = True
Command3.Visible = True
Command6.Visible = False
Command4.Visible = False
Text1.Text = ""
Form1.Cls
Exit Sub
err8:
Exit Sub
End Sub
Private Sub Command5_Click()
Form3.Show
End Sub
Private Sub Command6_Click()
If Text1.Text <> "CHK-QZW-VBSOFT-ABCE-LING-345-3S" Then
MsgBox "注册码错误!", vbOKOnly, "注册码错了"
Else
SaveSetting "myset", "settings", "prozcm", Text1.Text
Text1.Text = ""
Text1.Text = "注册成功，请按退出！"
End If
End Sub
Private Sub Command7_Click()
If Command7.Caption = "显示便签" Then
Command7.Caption = "关闭便签"
Text7.Visible = True
Text7.SelStart = Len(Trim(Text7.Text))
Command8.Visible = True
Command9.Visible = True
Text7.SetFocus
Else
Command7.Caption = "显示便签"
Text7.Visible = False
Command8.Visible = False
Command9.Visible = False
If Text7.Text <> "" Then
Label10.Visible = True
Else
Label10.Visible = False
End If
End If
End Sub
Private Sub Command8_Click()
Text7.Text = ""
End Sub
Private Sub Command9_Click()
Text7.Text = Text7.Text & vbCrLf & "--------------------------" & vbCrLf & "以上内容写于:" & Time & vbCrLf
End Sub
Private Sub Form_Load()
Dim test As Integer
Command6.Visible = False
If GetSetting("myset", "settings", "prozcmrq") = "" Then
SaveSetting "myset", "settings", "prozcmrq", Format(Now, "md")
MsgBox "这是您第一次使用本软件", vbOKOnly, "提示"
Else
If GetSetting("myset", "settings", "prozcm") <> "" Then
GoTo go
Else
If Val(Format(Now, "md")) - Val(GetSetting("myset", "settings", "prozcmrq")) <= 30 Then
Text6.Visible = False
Text5.Visible = False
Dim pOld As Boolean
Call SystemParametersInfo(SPI_SCREENSAVERRUNNING, True, pOld, 0)
On Error GoTo err2
Label7.FontBold = True
go:
If GetSetting("myset", "settings", "prozcm") = "CHK-QZW-VBSOFT-ABCE-LING-345-3S" Then
Text6.Visible = False
Text5.Visible = False
Text3.Visible = False
Text4.Visible = False
Command3.Visible = False
Label3.FontBold = True
Label3.FontItalic = True
Label3.FontUnderline = False
Timer1.Interval = 1000
Timer1.Enabled = True
Form1.Width = Screen.Width
Form1.Height = Screen.Height
Label1.Caption = "用户名:"
Label2.Caption = "密码:"
Text3.Visible = False
Text3.Enabled = True
Text4.Visible = False
Text4.Enabled = True
Label6.Visible = True
Else
Text6.Visible = False
Text5.Visible = False
Text3.Visible = False
Text4.Visible = False
Label3.FontBold = True
Label3.FontItalic = True
Label3.FontUnderline = True
Timer1.Interval = 1000
Timer1.Enabled = True
Form1.Width = Screen.Width
Form1.Height = Screen.Height
Label1.Caption = "用户名:"
Label2.Caption = "密码:"
Command1.Caption = "进入"
Text3.Visible = False
Text3.Enabled = True
Text4.Visible = False
Text4.Enabled = True
End If
Frame1.Caption = "用户登陆"
Exit Sub
Else
MsgBox "试用期已到，请注册本软件", vbOKOnly, "请注册"
Text6.Visible = False
Text5.Visible = False
Text3.Visible = False
Text4.Visible = False
Label3.FontBold = True
Text6.Visible = False
Text5.Visible = False
Label3.FontItalic = True
Label3.FontUnderline = True
Timer1.Interval = 1000
Timer1.Enabled = True
Form1.Width = Screen.Width
Form1.Height = Screen.Height
Label1.Caption = "用户名:"
Label2.Caption = "密码:"
Command1.Caption = "进入"
Text3.Visible = False
Text3.Enabled = True
Text4.Visible = False
Text4.Enabled = True
End If
End If
End If
Exit Sub
err2:
MsgBox "一个不知名错误!", vbOKOnly, "错误"
Exit Sub
End Sub

Private Sub Text1_Change()
If Text1.Text = "abcdefghijklm1" Then
Text1.PasswordChar = "*"
End If
End Sub
Private Sub Text1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Text2.SetFocus
End If
End Sub

Private Sub Text2_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Command1_Click
End If
End Sub


Private Sub Text7_KeyPress(KeyAscii As Integer)
If Right(Text7.Text, 3) + Chr(KeyAscii) = "@end" Then
Text7.Text = Left(Text7.Text, Len(Trim(Text7.Text)) - 3) & vbCrLf & "---------------------------" & vbCrLf & "以上内容写于:" & Time & vbCrLf
KeyAscii = 0
End If
End Sub

Private Sub Timer1_Timer()
On Error GoTo err3
Label5.Caption = "现在的时间是:" & " " & Now()
Exit Sub
err3:
MsgBox "一个不知名错误!", vbOKOnly, "错误"
Exit Sub
End Sub

以前写得很烂，大家不要笑话我，，：P

在winexec('Explorer.exe',sw_Show);的时候，首先要得到windows安装目录，因为真的Explorer.exe在
安装目录下：
procedure TForm1.Button1Click(Sender: TObject);
var dir:array [0..255] of char;
begin
GetWindowsDirectory(dir,255);
edit1.Text:=strpas(dir);
end;
//先定义一个dir数组是char类型的
//然后getwindowsdirectory(dir,255);
//用strpas函数来显示出来
//还有一个例子也可以做到如下:
procedure TForm1.Button1Click(Sender: TObject);
var
winpathchar;
begin
getmem(winpath,255);
GetWindowsDirectory(winpath,255);
edit1.text:=winpath;
end;
然后再shell出来，在程序运行期间，应该屏蔽alt,ctrl,del可以用
SystemParametersInfo(SPI_SCREENSAVERRUNNING, True, pOld, 0)//屏蔽
SystemParametersInfo(SPI_SCREENSAVERRUNNING, False, pOld, 0)//释放
适用于9X系统，我也是初学，大家多交流

to chatop
我看不明白啊!

你的程序是做什么的?
上面不是说做为登陆时用的吗？

to chatop
谢谢你的回答,不能放在根目录,放在C:盘根目录太显眼了!

晕，隐藏起来麻！…
你要做什么软件呀？
给我的感觉怎么怪怪的？
木马？
病毒？
恶做剧？

不需要引藏起来,例如我的程序安装到 c:/program files/idreamc/mylogin.exe
现在我想让mylogin.exe作为 shell怎么办?

你的mylogin.exe
是不是用来登陆系统的?
如果是这样的话，那上面的回答已经解决了你的问题了，可以结贴 了
winexec('c:/windows/Explorer.exe',sw_Show);
只有在真正的explorer.exe没有执行以前shell它，才会shell出桌面，否则会shell出资源管理器

to chatop
晕,请你实验一下再说好吧,还有你的VB我看不懂.

就是把程序名改成explorer.exe放在c:/根目录，枪先真正的explorer.exe执行，然后对系统的
热键进行屏蔽用
SystemParametersInfo(SPI_SCREENSAVERRUNNING, True, pOld, 0)//屏蔽CTRL+ALT+DEL
进行密码用户名验证
if 正确 then
begin
SystemParametersInfo(SPI_SCREENSAVERRUNNING, False, pOld, 0)//释放CTRL+ALT+DEL
取得windows安装目录用：
procedure TForm1.Button1Click(Sender: TObject);
var
winpathchar;
begin
getmem(winpath,255);
GetWindowsDirectory(winpath,255);
edit1.text:=winpath;
end;

然后shell出windows安装目录下的explorer.exe
edit1.text:=winpath+'explorer.exe';

winexec(edit1.text,sw_Show);
form.close;

这样就可以了
如果不把explorer.exe放在c盘根目录，那么就不会抢收先真正的explorer.exe执行，
你可以自己试试看，写一个空的explorer.exe放在c盘根目录，看看系统的样子，然后去掉后再看看
是什么样子，以上有vb原码我已实现了，对于9x系统绝对没有问题

to chatop 我不是说了不能放在根目录吗.
算了,还是问ligia能解决问题,用钱也值的.需要改注册表.

多人接受答案了。

g z