Chinaunix首页 | 论坛 | 博客
  • 博客访问: 4727961
  • 博文数量: 206
  • 博客积分: 5240
  • 博客等级: 大校
  • 技术积分: 3224
  • 用 户 组: 普通用户
  • 注册时间: 2010-08-12 21:40
文章分类

全部博文(206)

文章存档

2013年(13)

2012年(8)

2011年(33)

2010年(152)

我的朋友

分类: 系统运维

2010-09-27 22:29:48

应该是VB程序,你可以写生成用户名函数,然后POST数据,填表效率差啊!
附加:
'***************************************************************************************
'账号生成函数
'~  中文人名 【2-3汉字】
'^  拼音人名 【2-3汉字】

'!   随机一位百家姓拼音
'\   随机一位拼音
'B   随机1~3位百家姓拼音

'A  大写字母  【1个字母】
'a  小写字母  【1个字母】

'1  数字   【1位数字】

'#  百家姓  【1位百家姓】
'@  中文    【1位中文】

'%  随机1~3位小写字母
'*  随机1~3位数字
'$  随机1~3位中文
'***************************************************************************************
'~^!\&Aa1#@%*$

Private Function CreateFinallyName(ByVal FormatName As String) As String
    Dim UNameLen As Integer
    Dim i As Integer
    Dim TmpName As String
    Dim TmpWord As String
    
    UNameLen = Len(FormatName)
    
    If UNameLen > 0 Then
        For i = 1 To UNameLen
            TmpWord = Mid(FormatName, i, 1)
            Select Case TmpWord
            Case "~"
                '中文人名 【2-3汉字】
                TmpName = TmpName & TwoOrThreeRandomVariousFamiliesSurname(False)
            Case "^"
                '拼音人名 【2-3拼音】
                TmpName = TmpName & TwoOrThreeRandomVariousFamiliesSurnamePinYin(False)
            Case "A"
                '大写字母  【1个字母】
                TmpName = TmpName & OneRandomCapitalLetter
            Case "a"
                '小写字母  【1个字母】
                TmpName = TmpName & OneRandomSmallLetter
            Case "1"
                '数字   【1位数字】
                TmpName = TmpName & OneRandomNumber
            Case "#"
                '百家姓  【1位百家姓】
                TmpName = TmpName & TwoOrThreeRandomVariousFamiliesSurname(True)
            Case "@"
                '中文 【1位中文】
                TmpName = TmpName & OneToThreeRandomChineseCharacters(True)
            Case "%"
                '随机1~3位小写字母
                TmpName = TmpName & OneToThreeRandomSmallLetter
            Case "*"
                '随机1~3位数字
                TmpName = TmpName & OneToThreeRandomNumber
                
            Case "$"
                '随机1~3位中文
                TmpName = TmpName & OneToThreeRandomChineseCharacters(False)
            Case "!"
                '随机一位百家姓拼音
                TmpName = TmpName & TwoOrThreeRandomVariousFamiliesSurnamePinYin(True)
            Case "\"
                '随机一位拼音
                TmpName = TmpName & OneToThreeRandomPhoneticize(True)
            Case "B"
                '随机1~3位拼音
                TmpName = TmpName & OneToThreeRandomPhoneticize(False)
            Case Else
                TmpName = TmpName & TmpWord
            End Select
        Next i
    End If
    CreateFinallyName = TmpName
End Function

'*****************************************************
'
'生成 2~3位百家姓名拼音 或者一位百家姓拼音
'
'*****************************************************

Private Function TwoOrThreeRandomVariousFamiliesSurnamePinYin(IsBaiJiaXing As Boolean) As String
    
    Dim TempName As String
    Dim i As Integer
    Dim TmpAllChineseCharacters As String
    Dim TmpBaiJiaXing As String
    Dim ChineseCharacters() As String
    Dim BaiJiaXing() As String
    Dim ALLMaxCount As Integer
    Dim BJXMaxCount As Integer
    
    TmpBaiJiaXing = "zhao qian sun li zhou wu zheng wang feng chen chu wei jiang shen han yang zhu qin you xu he lv shi zhang kong cao yan hua jin wei tao jiang qi xie zou yu bai shui dou zhang yun su pan ge xi fan peng lang lu wei chang ma miao feng hua fang yu ren yuan liu feng bao shi tang fei lian cen xue lei he ni tang teng yin luo bi hao wu an chang le yu shi fu pi bian qi kang wu yu yuan bu gu meng ping huang h mu xiao yin yao shao kan wang qi mao yu di mi bei ming zang ji fu cheng dai tan song mao pang xiong ji shu qu xiang zhu dong liang du ruan lan min xi ji ma qiang jia lu lou wei jiang tong yan guo mei sheng lin diao zhong xu qiu nuo gao xia cai tian fan hu ling huo yu wan zhi ke jiu guan lu mo jing fang qiu miu gan jie ying zong xuan ding ben deng yu dan hang hong bao zhu zuo shi cui ji niu gong cheng ji xing hua pei lu rong weng xun yang yu hui zhen wei jia feng rui yi chu jin ji bing mi song jing duan fu wu jiao ba gong mu wei shan gu che hou mi peng quan xi ban yang qiu zhong yi " & _
    "gong ning chou luan bao gan dou li rong zu wu fu liu jiang zhan shu long ye xing si shao gao li ji bao yin xiu bai huai pu tai cong e suo xian ji lai zhuo lin tu meng chi qiao yin yu xu neng cang shuang wen shen dang zhai tan gong lao pang ji shen fu du ran zai li yong xi qu sang gui pu niu shou tong bian hu yan ji jia pu shang nong wen bie zhuang yan chai qu yan chong mu lian ru xi huan ai yu rong xiang gu yi shen ge liao geng zhong ju heng bu dou geng man hong kuang guo wen kou guang lu que dong ou shu wo li wei yue kui long shi gong she nie chao gouao rong leng zi xin kan na jian rao kong ceng wu sha nie yang ju xu feng chao guan kuai xiang cha hou jiang hong you zhu quan lu gai yi huan gong wans sima shangguan ouyang shangmou sheer boshang nangong moha qiaoda nia nai yangtong diwu yanfu xiahou zhuge wenren dongfang helian huangfu yuchi gongyang dantai gongye zongzheng puyang chunyu zhongsun taishu shentu gongsun lezheng xuanyuan linghu zhong li lv qiu zhangsun murong xianyu yuwen situ sikong" & _
    " qiguan sikou zhangdu ziche zhuansun duanmu wuma gongxi qidiao lezheng rangsi gongliang tuoba jiagu zaifu guliang jin chu yan fa ru yan tu qin duangan baili dongguo nanmen huyan guihai yangshe wei shengyue shuai gou kang kuang hou youqin liangqiu zuoqiu dongmen ximen"
    
    TmpAllChineseCharacters = "ai an ang ao ba bai ban bang bao bei ben beng bi bian biao bie bin bing bo bu ca cai can cang cao ce cen ceng cha chai chan chang chao che che chen cheng chi chong chou chu chuai chuan chuang chui chun chuo ci cong cou cu cuan cui cun cuo da dai dan dang dao de deng di dia dian diao die ding diu dong dou du duan dui dun duo e ei en eng er fa fan fang fei fen feng feng fo fou fu ga gai gan gang gao ge gei gen geng gong gou gu gua guai guan guang gui gun guo ha hai han hang hao he hei hen heng hong hou hu hua huai huan huang hui hun huo ji jia jian jiang jiaoj ie jin jing jiong jiu ju juan jue jun ka kai kan kang kao ke kei ken keng kong kou ku kua kuai kuan kuang kui kun kuo la lai lan lang lao le lei leng li lian liang liao lie lin ling liu long long lou lu luan lue lun luo luo lv ma mai man mang mao me mei men meng meng mi mian miao mie min ming miu mo mou mu na nai nan nang nao nao ne nei nen neng ni nian niang niao " & _
    "pa pai pak pan pang pao pei pen peng peol phas phi deng phoi phos pi pian piao pi pin ping po pou pun pu qi qia qian qiang qianke qianwa qiao qie qin qing qiong qiu qu quan que qun ra ram ran rang rao re ren reng ri rong rou ru ruan rui run ruo sa saeng sai sal san sang sao se sed sei sen seng seo seon sha shai shan shang shao she shen sheng shi shi ke shi wa shou shu shua shuai shuan shuang shui shun suo si so sol song sou su suan sui sun suo ta tae tai tan tang tao tap te teng teo teul teun ti tian tiao tie ting tol ton tong tou tu tuan tui tun tuo wa wai wan wang wei wen weng wie wo wu xi xia xian Xiang xiao xie xin xing xiong xiu xu xuan xue xun ya yanyan yang yao ye ye yen yi yin yin ying yo yong you yu yuan yue yug yun za za zad zai zan zang zao ze zei zen zeng zha zhai zhan zhang zhao zhe zhei zhen zheng zhi zhong zhou zhu zhua zhuai zhuan zhuang zhui zhun zhuo zi zo zong zou zu zuan zui zun zuo nie nin ning niu nong nou nu nuan nue nun nung nuo nv nve ou"
    
    BaiJiaXing = Split(TmpBaiJiaXing, " ")
    BJXMaxCount = UBound(BaiJiaXing)
    
    ChineseCharacters = Split(TmpAllChineseCharacters, " ")
    ALLMaxCount = UBound(ChineseCharacters)
    
    If IsBaiJiaXing = False Then
        
        For i = 1 To OneToTwoRandom
            Randomize
            TempName = TempName & ChineseCharacters((ALLMaxCount) * Rnd())
        Next i
        
    Else
        Randomize
        TwoOrThreeRandomVariousFamiliesSurnamePinYin = BaiJiaXing((BJXMaxCount) * Rnd())
        Exit Function
    End If
    
    Randomize
    TwoOrThreeRandomVariousFamiliesSurnamePinYin = BaiJiaXing((BJXMaxCount) * Rnd()) & TempName
End Function

'*****************************************************
'
'生成 2~3位百家姓名 或者一位百家姓
'
'*****************************************************

Private Function TwoOrThreeRandomVariousFamiliesSurname(IsBaiJiaXing As Boolean) As String
    
    Dim TempName As String
    Dim i As Integer
    Dim TmpAllChineseCharacters As String
    Dim TmpBaiJiaXing As String
    Dim ChineseCharacters() As String
    Dim BaiJiaXing() As String
    Dim ALLMaxCount As Integer
    Dim BJXMaxCount As Integer
    
    TmpBaiJiaXing = "赵 钱 孙 李 周 吴 郑 王 冯 陈 褚 卫 蒋 沈 韩 杨 朱 秦 尤 许 何 吕 施 张 孔 曹 严 华 金 魏 陶 姜 戚 谢 邹 喻 柏 水 窦 章 云 苏 潘 葛 奚 范 彭 郎 鲁 韦 昌 马 苗 凤 花 方 俞 任 袁 柳 酆 鲍 史 唐 费 廉 岑 薛 雷 贺 倪 汤 滕 殷 罗 毕 郝 邬 安 常 乐 于 时 傅 皮 卞 齐 康 伍 余 元 卜 顾 孟 平 黄 和 穆 萧 尹 姚 邵 堪 汪 祁 毛 禹 狄 米 贝 明 臧 计 伏 成 戴 谈 宋 茅 庞 熊 纪 舒 屈 项 祝 董 粱 杜 阮 蓝 闵 席 季 麻 强 贾 路 娄 危 江 童 颜 郭 梅 盛 林 刁 钟 徐 邱 骆 高 夏 蔡 田 樊 胡 凌 霍 虞 万 支 柯 咎 管 卢 莫 经 房 裘 缪 干 解 应 宗 宣 丁 贲 邓 郁 单 杭 洪 包 诸 左 石 崔 吉 钮 龚 程 嵇 邢 滑 裴 陆 荣 翁 荀 羊 於 惠 甄 魏 加 封 芮 羿 储 靳 汲 邴 糜 松 井 段 富 巫 乌 焦 巴 弓 牧 隗 山 谷 车 侯 宓 蓬 全 郗 班 仰 秋 仲 伊 宫 宁 仇 栾 暴 甘 钭 厉 戎 祖 武 符 刘 姜 詹 束 龙 叶 幸 司 韶 郜 黎 蓟 薄 印 宿 白 怀 蒲 台 从 鄂 索 咸 籍 赖 卓 蔺 屠 蒙 池 乔 阴 郁 胥 能 苍 双 闻 莘 党 翟 谭 贡 劳 逄 姬 申 扶 堵 冉 宰 郦 雍 郤 璩 桑 桂 濮 牛 寿 通 边 扈 燕 冀 郏 浦 尚 农 " & _
    "温 别 庄 晏 柴 瞿 阎 充 慕 连 茹 习 宦 艾 鱼 容 向 古 易 慎 戈 廖 庚 终 暨 居 衡 步 都 耿 满 弘 匡 国 文 寇 广 禄 阙 东 殴 殳 沃 利 蔚 越 夔 隆 师 巩 厍 聂 晁 勾 敖 融 冷 訾 辛 阚 那 简 饶 空 曾 毋 沙 乜 养 鞠 须 丰 巢 关 蒯 相 查 后 江 红 游 竺 权 逯 盖 益 桓 公 万俟 司马 上官 欧阳 夏侯 诸葛 闻人 东方 赫连 皇甫 尉迟 公羊 澹台 公冶 宗政 濮阳 淳于 仲孙 太叔 申屠 公孙 乐正 轩辕 令狐 钟离 闾丘 长孙 慕容 鲜于 宇文 司徒 司空 亓官 司寇 仉督 子车 颛孙 端木 巫马 公西 漆雕 乐正 壤驷 公良 拓拔 夹谷 宰父 谷粱 晋 楚 阎 法 汝 鄢 涂 钦 段干 百里 东郭 南门 呼延 妫 海 羊舌 微生 岳 帅 缑 亢 况 後 有 琴 梁丘 左丘 东门 西门 商 牟 佘 佴 伯 赏 南宫 墨 哈 谯 笪 年 爱 阳 佟 第五 言 福 百 家 姓 续"
    
    TmpAllChineseCharacters = "一 乙 二 乃 了 人 入 刀 力 卜 又 几 丁 三 上 下 久 个 丸 乞 也 于 千 大 子 寸 小 山 川 工 己 匀 女 子 四 中 丹 之 予 云 井 亢 介 仁 元 公 切 分 化 午 升 友 及 太 天 夫 少 引 心 户 支 文 斗 斤 方 日 月 木 火 水 比 画 五 丘 且 世 丙 主 井 仕 仙 代 令 充 冬 出 加 功 包 北 半 占 卯 右 可 句 叶 古 司 只 召 外 本 巧 巨 市 布 平 弘 弗 必 戊 旦 正 民 永 玉 瓦 甘 生 用 田 由 甲 申 白 目 石 穴 立 六 亘 交 仰 任 仲 伏 仔 光 先 兆 全 共 再 列 印 合 吉 向 后 同 名 宇 存 安 字 守 州 帆 年 旭 早 有 求 百 弛 竹 米 羊 羽 臣 自 至 舟 行 衣 西 回 如 成 七 亨 吾 均 坐 壮 声 妙 孝 宏 局 希 序 志 戒 改 更 杏 材 村 位 佑 作 伯 伴 体 余 克 兑 兔 兵 初 判 利 助 告 君 步 江 汗 汝 池 秀 究 良 见 言 谷 豆 赤 车 辰 八 并 事 亨 京 依 佳 侃 供 侍 使 佩 来 例 免 雨 其 具 典 冒 冽 函 刻 刷 刹 制 到 效 协 卓 卷 取 受 和 周 命 固 坤 垂 坦 坡 夜 奇 奈 奉 姑 始 妹 枚 板 林 欣 武 汲 决 沙 汰 冲 沛 沐 沃 汪 炎 炊 版 物 牧 玖 的 直 盲 知 社 空 究 舌 虎 采 金 长 昔 明 旺 服 朋 杭 果 枝 松 扭 东 门 " & _
    "青 季 孟 宜 官 宗 宙 定 尚 居 岳 岸 岩 岱 幸 庚 店 府 弦 征 彼 往 快 忽 忠 念 或 所 房 技 承 折 扶 政 放 齐 于 昂 昆 昌 升 昊 九 亭 亮 系 侠 信 俊 保 便 侣 俞 冒 冠 克 前 则 劲 勉 勃 勇 南 厚 叙 咸 哄 品 垠 奎 奏 威 姻 姬 姜 妍 姿 客 宣 室 屋 巷 帝 幽 度 回 建 彦 待 律 思 性 易 招 拓 折 拜 抱 施 映 昨 是 春 星 昭 架 柯 查 柴 柔 柘 韦 柱 柏 柄 柳 段 油 泳 沿 河 况 注 泉 泰 治 波 泊 法 冷 炳 帅 甚 界 皆 皇 盈 看 相 眉 祈 科 秋 秒 穿 突 竿 红 罕 美 耐 肖 衍 表 要 计 订 贞 军 重 门 面 革 音 风 飞 食 首 香 姣 十 乘 倚 幸 仓 修 借 值 倍 仿 表 伦 党 兼 倡 刚 原 员 哥 唐 哲 城 夏 娥 宴 家 宫 宰 容 射 展 峡 岛 峰 师 席 库 航 般 芽 芹 花 芝 芳 娘 袁 衿 活 洪 洲 洗 洞 派 洋 流 烘 烈 特 珂 珊 珍 玲 益 真 词 神 祝 组 祚 秦 秤 租 秘 并 竟 级 纱 纯 素 纳 纽 纺 纹 翁 者 耘 耿 育 股 皋 座 庭 径 徐 恩 恭 恢 恒 恤 息 恬 扇 拾 持 效 料 旁 旅 晏 晃 时 晋 书 朔 校 格 桂 根 栖 桃 桐 钊 殊 气 记 训 讨 豹 贡 财 起 马 支 高 娟 倩 娜 乾 伟 偕 健 偶 侧 停 侦 富 凰 剩 副 勘 动 务 课 谈 " & _
    "区 卿 参 唯 启 商 唱 珠 般 产 皎 尽 眼 婉 研 祥 移 竟 章 笛 伏 笙 弦 紫 绅 绍 绊 累 罩 习 翌 者 聊 胡 教 敏 斌 斜 旌 旋 族 晤 晨 晚 曹 望 朗 梗 梧 梓 梅 梨 梁 毫 球 海 浩 涉 涌 浴 烽 爽 崇 国 基 坚 执 堂 培 寅 寄 宿 寂 密 尉 寻 将 专 崔 巢 常 带 康 强 张 彩 彤 雕 彬 从 悦 悟 戚 挺 英 婕 若 苔 苗 茂 术 袖 许 责 赦 近 闭 雪 顷 顶 鹿 麦 麻 佩 闰 闵 雅 雁 集 云 项 须 顺 劳 喜 乔 善 单 喻 围 堪 尧 场 堤 报 堡 媒 媚 寒 寓 寻 尊 岚 巽 帽 几 复 惟 情 荀 茜 茶 扇 掘 卷 扫 舍 掌 迫 贰 量 开 闲 间 添 焰 无 为 犁 猛 球 现 理 番 媛 登 授 捷 敢 散 敦 斑 敲 斯 晶 晴 晰 最 替 期 朝 棋 棍 栈 森 植 荒 草 接 棠 栋 棒 棉 款 证 注 评 象 贵 贴 贸 越 超 迪 茹 旋 茫 众 街 词 渊 涯 涵 混 深 淑 清 净 浅 淘 淡 焕 发 盛 砚 稀 稍 税 程 窗 竣 曜 曛 曙 归 濠 阔 湿 济 涛 爵 获 狞 猎 环 瞻 礼 馈 箫 绣 织 缮 翻 异 职 旧 荫 蕊 蕃 蝉 声 讴 谨 丰 转 遭 适 鄙 医 锁 镇 锤 镰 聂 鸡 乡 离 雏 额 频 骑 鹃 灿 蕙 鞭 碧 霞 蒲 劝 宝 庐 扩 攀 旷 莹 泻 溅 瀑 滨 镜 关 雾 韵 愿 类 鲸 鹊 鹏 麓 兽 猎 祷 稳 获 " & _
    "童 策 答 筑 筒 等 笔 筏 栗 绞 给 吉 绚 絮 绝 统 络 翔 能 舜 黄 黑 备 传 割 胜 仅 债 杰 催 惠 伤 舒 倦 传 勤 势 募 嗣 园 圆 块 干 廊 渡 湃 渺 照 煎 媒 炼 爷 琴 琢 琵 琶 棱 督 睦 碇 禁 禄 禽 稚 坚 绢 义 圣 廉 巢 微 爱 意 惮 荣 感 愚 想 愉 愈 斟 新 暑 会 极 楚 楠 枫 椰 榆 殿 景 钞 钦 温 港 渠 湖 湘 测 汤 铁 佃 附 雌 雉 聘 肆 琛 唇 脱 台 获 莓 莫 蜀 衙 裟 装 裕 里 解 咏 夸 詹 资 迹 跳 路 载 农 退 乃 郊 电 赓 雷 颂 顿 预 饮 驯 驰 鼎 鼓 雍 经 莆 莎 莉 普 创 诏 雄 博 弼 智 贺 皓 凯 团 图 境 寿 梦 奖 察 实 对 伪 侨 像 佟 煌 仆 僚 崭 廓 彰 愿 慈 慎 态 搬 业 旗 畅 槐 枪 沟 歌 溢 温 溪 源 滋 支 溶 熊 雨 犒 猿 狮 瑚 瑟 瑞 鼓 监 尽 廖 硕 祯 福 种 称 竭 端 个 算 精 紧 绰 绶 综 绯 绵 维 纶 绫 置 翠 翡 靖 晖 台 与 舞 菊 董 华 果 菜 蜻 蜜 裙 裳 诫 诰 诲 诚 誓 说 诞 认 貌 赈 宾 暄 铃 轻 赵 群 郎 酸 铅 阁 韶 领 饰 饱 仿 魁 魏 诗 试 询 诠 援 挥 扬 凰 鸣 鼻 齐 瑛 瑗 榕 碌 诱 宁 玮 椿 曾 琳 群 杨 虞 当 盟 酩 仪 俭 僻 剧 剑 劈 刘 啸 豪 娇 宽 番 寮 履 帜 广 熙 弹 影 微 彻 慰 慷 断 " & _
    "醉 锐 锄 锋 阅 院 阵 宵 霆 霈 颐 落 蝶 冲 褓 复 薄 绳 调 谅 论 赐 质 赏 卖 趣 践 辈 轮 替 游 进 邮 部 醇 确 磁 磐 稼 稿 谷 稻 穷 箱 节 箭 范 篇 糊 纬 缘 缄 绪 线 致 缔 编 练 暑 义 铺 馆 苇 叶 葛 葵 管 萱 著 董 慕 虑 掴 摧 摩 数 暂 暴 暮 概 乐 槽 樟 枢 标 模 样 楼 欢 毅 演 汉 渐 涨 滞 漫 满 洋 熟 热 荧 瑶 玛 郎 几 皓 盘 驾 驻 魄 鸦 华 燕 惯 慧 嘉 碧 樊 蒂 颖 块 发 葆 渔 漆 纲 尝 彰 志 赫 辅 造 逍 速 逞 途 透 通 逢 连 静 萤 阴 银 铜 铭 齐 仅 万 冀 剑 进 器 喷 坛 壁 奋 道 岭 憬 憧 抚 怜 战 撮 撤 撰 幢 播 扑 整 德 晕 厉 机 陆 陵 鞘 头 余 默 龙 桦 横 桥 橇 树 樽 橙 竖 洁 润 泄 贤 增 郭 赋 烨 烧 燃 炖 磷 燎 芦 穆 窥 筛 筑 糖 县 罢 翰 举 苍 蒸 席 辉 震 墨 卫 衡 亲 谓 谒 诚 谏 谚 诸 豫 蹄 辑 办 运 远 遇 遂 道 达 都 醒 钢 锦 铮 锡 钱 总 橡 震 敬 慧 磊 庆 儒 优 赏 励 壕 壑 岳 应 忆 撼 擒 擎 检 操 擅 择 擂 敛 檄 檀 褒 讲 谦 谢 豁 趋 融 远 乡 键 针 钟 锻 阶 队 阳 隆 霜 鞠 韩 馆 骏 鲜 黛 点 齐 鸿 荫 襁 激 浓 营 灿 烛 燧 微 响 独 瞰 瞬 禅 簇 篷 纵 繁 缝 声 聪 聊 临 艰 擦 " & _
    "参 蔗 谅 蔬 篷 莲 赛 璜 燃 兴 学 遥 晓 霖 澄 潮 潜 潭 蓉 蓄 茜 颖 璇 蓓 陶 陈 谘 璋 逸 霓 谋 戴 搁 拟 薪 蔷 薇 襟 识 证 赞 赠 辞 郑 鞠 丰 题 简 还 释 钟 阐 露 飘 馨 璃 龄 宝 迈 怀 悬 胧 沥 献 琼 砾 籍 筹 篮 继 办 罗 麒 藏 萨 籍 薯 觉 触 译 议 警 赢 面 锈 瀚 瀛 烁 蕾 选 辽 遵 迟 臆 臂 膺 荡 顾 翻 饶 驱 莺 鹤 鸡 傈 属 巍 续 缠 腊 护 誉 贴 轰 辩 随 隐 霸 竞 耀 宝 艺 俨 巅 摄 权 欢 灌 叠 穰 笼 听 澡 苏 芦 览 赞 读 边 鉴 乡 餐 须 蔺 懿 樱 铁 岩 恋 织 藓 兰 变 矿 显 驿 验 髓 体 乐 麟 龚 矗 罐 艳 禳 酿 炉 陇 谒 灵 鹰 鑫 篱 蛮 观 才 湾 瞩 赞 逻 爵 厌 锣 銮 缆 艳 欢 鹦 麓"
    
    BaiJiaXing = Split(TmpBaiJiaXing, " ")
    BJXMaxCount = UBound(BaiJiaXing)
    
    ChineseCharacters = Split(TmpAllChineseCharacters, " ")
    ALLMaxCount = UBound(ChineseCharacters)
    
    If IsBaiJiaXing = False Then
        
        For i = 1 To OneToTwoRandom
            Randomize
            TempName = TempName & ChineseCharacters((ALLMaxCount) * Rnd())
        Next i
        
    Else
        Randomize
        TwoOrThreeRandomVariousFamiliesSurname = BaiJiaXing((BJXMaxCount) * Rnd())
        Exit Function
    End If
    
    Randomize
    TwoOrThreeRandomVariousFamiliesSurname = BaiJiaXing((BJXMaxCount) * Rnd()) & TempName
End Function

'*****************************************************
'
'生成一到三位随中文 或1位中文
'
'*****************************************************

Private Function OneToThreeRandomChineseCharacters(IsOneChineseCharacters As Boolean) As String
    
    Dim i As Integer
    Dim TmpAllChineseCharacters As String
    Dim ChineseCharacters() As String
    Dim MaxCount As Integer
    
    TmpAllChineseCharacters = "一 乙 二 乃 了 人 入 刀 力 卜 又 几 丁 三 上 下 久 个 丸 乞 也 于 千 大 子 寸 小 山 川 工 己 匀 女 子 四 中 丹 之 予 云 井 亢 介 仁 元 公 切 分 化 午 升 友 及 太 天 夫 少 引 心 户 支 文 斗 斤 方 日 月 木 火 水 比 画 五 丘 且 世 丙 主 井 仕 仙 代 令 充 冬 出 加 功 包 北 半 占 卯 右 可 句 叶 古 司 只 召 外 本 巧 巨 市 布 平 弘 弗 必 戊 旦 正 民 永 玉 瓦 甘 生 用 田 由 甲 申 白 目 石 穴 立 六 亘 交 仰 任 仲 伏 仔 光 先 兆 全 共 再 列 印 合 吉 向 后 同 名 宇 存 安 字 守 州 帆 年 旭 早 有 求 百 弛 竹 米 羊 羽 臣 自 至 舟 行 衣 西 回 如 成 七 亨 吾 均 坐 壮 声 妙 孝 宏 局 希 序 志 戒 改 更 杏 材 村 位 佑 作 伯 伴 体 余 克 兑 兔 兵 初 判 利 助 告 君 步 江 汗 汝 池 秀 究 良 见 言 谷 豆 赤 车 辰 八 并 事 亨 京 依 佳 侃 供 侍 使 佩 来 例 免 雨 其 具 典 冒 冽 函 刻 刷 刹 制 到 效 协 卓 卷 取 受 和 周 命 固 坤 垂 坦 坡 夜 奇 奈 奉 姑 始 妹 枚 板 林 欣 武 汲 决 沙 汰 冲 沛 沐 沃 汪 炎 炊 版 物 牧 玖 的 直 盲 知 社 空 究 舌 虎 采 金 长 昔 明 旺 服 朋 杭 果 枝 松 扭 东 门 " & _
    "青 季 孟 宜 官 宗 宙 定 尚 居 岳 岸 岩 岱 幸 庚 店 府 弦 征 彼 往 快 忽 忠 念 或 所 房 技 承 折 扶 政 放 齐 于 昂 昆 昌 升 昊 九 亭 亮 系 侠 信 俊 保 便 侣 俞 冒 冠 克 前 则 劲 勉 勃 勇 南 厚 叙 咸 哄 品 垠 奎 奏 威 姻 姬 姜 妍 姿 客 宣 室 屋 巷 帝 幽 度 回 建 彦 待 律 思 性 易 招 拓 折 拜 抱 施 映 昨 是 春 星 昭 架 柯 查 柴 柔 柘 韦 柱 柏 柄 柳 段 油 泳 沿 河 况 注 泉 泰 治 波 泊 法 冷 炳 帅 甚 界 皆 皇 盈 看 相 眉 祈 科 秋 秒 穿 突 竿 红 罕 美 耐 肖 衍 表 要 计 订 贞 军 重 门 面 革 音 风 飞 食 首 香 姣 十 乘 倚 幸 仓 修 借 值 倍 仿 表 伦 党 兼 倡 刚 原 员 哥 唐 哲 城 夏 娥 宴 家 宫 宰 容 射 展 峡 岛 峰 师 席 库 航 般 芽 芹 花 芝 芳 娘 袁 衿 活 洪 洲 洗 洞 派 洋 流 烘 烈 特 珂 珊 珍 玲 益 真 词 神 祝 组 祚 秦 秤 租 秘 并 竟 级 纱 纯 素 纳 纽 纺 纹 翁 者 耘 耿 育 股 皋 座 庭 径 徐 恩 恭 恢 恒 恤 息 恬 扇 拾 持 效 料 旁 旅 晏 晃 时 晋 书 朔 校 格 桂 根 栖 桃 桐 钊 殊 气 记 训 讨 豹 贡 财 起 马 支 高 娟 倩 娜 乾 伟 偕 健 偶 侧 停 侦 富 凰 剩 副 勘 动 务 课 谈 " & _
    "区 卿 参 唯 启 商 唱 珠 般 产 皎 尽 眼 婉 研 祥 移 竟 章 笛 伏 笙 弦 紫 绅 绍 绊 累 罩 习 翌 者 聊 胡 教 敏 斌 斜 旌 旋 族 晤 晨 晚 曹 望 朗 梗 梧 梓 梅 梨 梁 毫 球 海 浩 涉 涌 浴 烽 爽 崇 国 基 坚 执 堂 培 寅 寄 宿 寂 密 尉 寻 将 专 崔 巢 常 带 康 强 张 彩 彤 雕 彬 从 悦 悟 戚 挺 英 婕 若 苔 苗 茂 术 袖 许 责 赦 近 闭 雪 顷 顶 鹿 麦 麻 佩 闰 闵 雅 雁 集 云 项 须 顺 劳 喜 乔 善 单 喻 围 堪 尧 场 堤 报 堡 媒 媚 寒 寓 寻 尊 岚 巽 帽 几 复 惟 情 荀 茜 茶 扇 掘 卷 扫 舍 掌 迫 贰 量 开 闲 间 添 焰 无 为 犁 猛 球 现 理 番 媛 登 授 捷 敢 散 敦 斑 敲 斯 晶 晴 晰 最 替 期 朝 棋 棍 栈 森 植 荒 草 接 棠 栋 棒 棉 款 证 注 评 象 贵 贴 贸 越 超 迪 茹 旋 茫 众 街 词 渊 涯 涵 混 深 淑 清 净 浅 淘 淡 焕 发 盛 砚 稀 稍 税 程 窗 竣 曜 曛 曙 归 濠 阔 湿 济 涛 爵 获 狞 猎 环 瞻 礼 馈 箫 绣 织 缮 翻 异 职 旧 荫 蕊 蕃 蝉 声 讴 谨 丰 转 遭 适 鄙 医 锁 镇 锤 镰 聂 鸡 乡 离 雏 额 频 骑 鹃 灿 蕙 鞭 碧 霞 蒲 劝 宝 庐 扩 攀 旷 莹 泻 溅 瀑 滨 镜 关 雾 韵 愿 类 鲸 鹊 鹏 麓 兽 猎 祷 稳 获 " & _
    "童 策 答 筑 筒 等 笔 筏 栗 绞 给 吉 绚 絮 绝 统 络 翔 能 舜 黄 黑 备 传 割 胜 仅 债 杰 催 惠 伤 舒 倦 传 勤 势 募 嗣 园 圆 块 干 廊 渡 湃 渺 照 煎 媒 炼 爷 琴 琢 琵 琶 棱 督 睦 碇 禁 禄 禽 稚 坚 绢 义 圣 廉 巢 微 爱 意 惮 荣 感 愚 想 愉 愈 斟 新 暑 会 极 楚 楠 枫 椰 榆 殿 景 钞 钦 温 港 渠 湖 湘 测 汤 铁 佃 附 雌 雉 聘 肆 琛 唇 脱 台 获 莓 莫 蜀 衙 裟 装 裕 里 解 咏 夸 詹 资 迹 跳 路 载 农 退 乃 郊 电 赓 雷 颂 顿 预 饮 驯 驰 鼎 鼓 雍 经 莆 莎 莉 普 创 诏 雄 博 弼 智 贺 皓 凯 团 图 境 寿 梦 奖 察 实 对 伪 侨 像 佟 煌 仆 僚 崭 廓 彰 愿 慈 慎 态 搬 业 旗 畅 槐 枪 沟 歌 溢 温 溪 源 滋 支 溶 熊 雨 犒 猿 狮 瑚 瑟 瑞 鼓 监 尽 廖 硕 祯 福 种 称 竭 端 个 算 精 紧 绰 绶 综 绯 绵 维 纶 绫 置 翠 翡 靖 晖 台 与 舞 菊 董 华 果 菜 蜻 蜜 裙 裳 诫 诰 诲 诚 誓 说 诞 认 貌 赈 宾 暄 铃 轻 赵 群 郎 酸 铅 阁 韶 领 饰 饱 仿 魁 魏 诗 试 询 诠 援 挥 扬 凰 鸣 鼻 齐 瑛 瑗 榕 碌 诱 宁 玮 椿 曾 琳 群 杨 虞 当 盟 酩 仪 俭 僻 剧 剑 劈 刘 啸 豪 娇 宽 番 寮 履 帜 广 熙 弹 影 微 彻 慰 慷 断 " & _
    "醉 锐 锄 锋 阅 院 阵 宵 霆 霈 颐 落 蝶 冲 褓 复 薄 绳 调 谅 论 赐 质 赏 卖 趣 践 辈 轮 替 游 进 邮 部 醇 确 磁 磐 稼 稿 谷 稻 穷 箱 节 箭 范 篇 糊 纬 缘 缄 绪 线 致 缔 编 练 暑 义 铺 馆 苇 叶 葛 葵 管 萱 著 董 慕 虑 掴 摧 摩 数 暂 暴 暮 概 乐 槽 樟 枢 标 模 样 楼 欢 毅 演 汉 渐 涨 滞 漫 满 洋 熟 热 荧 瑶 玛 郎 几 皓 盘 驾 驻 魄 鸦 华 燕 惯 慧 嘉 碧 樊 蒂 颖 块 发 葆 渔 漆 纲 尝 彰 志 赫 辅 造 逍 速 逞 途 透 通 逢 连 静 萤 阴 银 铜 铭 齐 仅 万 冀 剑 进 器 喷 坛 壁 奋 道 岭 憬 憧 抚 怜 战 撮 撤 撰 幢 播 扑 整 德 晕 厉 机 陆 陵 鞘 头 余 默 龙 桦 横 桥 橇 树 樽 橙 竖 洁 润 泄 贤 增 郭 赋 烨 烧 燃 炖 磷 燎 芦 穆 窥 筛 筑 糖 县 罢 翰 举 苍 蒸 席 辉 震 墨 卫 衡 亲 谓 谒 诚 谏 谚 诸 豫 蹄 辑 办 运 远 遇 遂 道 达 都 醒 钢 锦 铮 锡 钱 总 橡 震 敬 慧 磊 庆 儒 优 赏 励 壕 壑 岳 应 忆 撼 擒 擎 检 操 擅 择 擂 敛 檄 檀 褒 讲 谦 谢 豁 趋 融 远 乡 键 针 钟 锻 阶 队 阳 隆 霜 鞠 韩 馆 骏 鲜 黛 点 齐 鸿 荫 襁 激 浓 营 灿 烛 燧 微 响 独 瞰 瞬 禅 簇 篷 纵 繁 缝 声 聪 聊 临 艰 擦 " & _
    "参 蔗 谅 蔬 篷 莲 赛 璜 燃 兴 学 遥 晓 霖 澄 潮 潜 潭 蓉 蓄 茜 颖 璇 蓓 陶 陈 谘 璋 逸 霓 谋 戴 搁 拟 薪 蔷 薇 襟 识 证 赞 赠 辞 郑 鞠 丰 题 简 还 释 钟 阐 露 飘 馨 璃 龄 宝 迈 怀 悬 胧 沥 献 琼 砾 籍 筹 篮 继 办 罗 麒 藏 萨 籍 薯 觉 触 译 议 警 赢 面 锈 瀚 瀛 烁 蕾 选 辽 遵 迟 臆 臂 膺 荡 顾 翻 饶 驱 莺 鹤 鸡 傈 属 巍 续 缠 腊 护 誉 贴 轰 辩 随 隐 霸 竞 耀 宝 艺 俨 巅 摄 权 欢 灌 叠 穰 笼 听 澡 苏 芦 览 赞 读 边 鉴 乡 餐 须 蔺 懿 樱 铁 岩 恋 织 藓 兰 变 矿 显 驿 验 髓 体 乐 麟 龚 矗 罐 艳 禳 酿 炉 陇 谒 灵 鹰 鑫 篱 蛮 观 才 湾 瞩 赞 逻 爵 厌 锣 銮 缆 艳 欢 鹦 麓"
    
    ChineseCharacters = Split(TmpAllChineseCharacters, " ")
    MaxCount = UBound(ChineseCharacters)
    
    If IsOneChineseCharacters = False Then
        For i = 1 To OneToThreeRandom
            Randomize
            OneToThreeRandomChineseCharacters = OneToThreeRandomChineseCharacters & ChineseCharacters((MaxCount) * Rnd())
        Next i
    Else
        OneToThreeRandomChineseCharacters = ChineseCharacters((MaxCount) * Rnd())
    End If
End Function

'*****************************************************
'
'生成一到三位随拼音 或1位拼音
'
'*****************************************************

Private Function OneToThreeRandomPhoneticize(IsOnePinYin As Boolean) As String
    
    Dim i As Integer
    Dim TmpAllPinYin As String
    Dim PinYin() As String
    Dim MaxCount As Integer
    
    TmpAllPinYin = "ai an ang ao ba bai ban bang bao bei ben beng bi bian biao bie bin bing bo bu ca cai can cang cao ce cen ceng cha chai chan chang chao che che chen cheng chi chong chou chu chuai chuan chuang chui chun chuo ci cong cou cu cuan cui cun cuo da dai dan dang dao de deng di dia dian diao die ding diu dong dou du duan dui dun duo e ei en eng er fa fan fang fei fen feng feng fo fou fu ga gai gan gang gao ge gei gen geng gong gou gu gua guai guan guang gui gun guo ha hai han hang hao he hei hen heng hong hou hu hua huai huan huang hui hun huo ji jia jian jiang jiaoj ie jin jing jiong jiu ju juan jue jun ka kai kan kang kao ke kei ken keng kong kou ku kua kuai kuan kuang kui kun kuo la lai lan lang lao le lei leng li lian liang liao lie lin ling liu long long lou lu luan lue lun luo luo lv ma mai man mang mao me mei men meng meng mi mian miao mie min ming miu mo mou mu na nai nan nang nao nao ne nei nen neng ni nian niang niao nie nin ning niu nong nou nu nuan nue nun nung nuo nv nve ou" & _
    "pa pai pak pan pang pao pei pen peng peol phas phi deng phoi phos pi pian piao pi pin ping po pou pun pu qi qia qian qiang qianke qianwa qiao qie qin qing qiong qiu qu quan que qun ra ram ran rang rao re ren reng ri rong rou ru ruan rui run ruo sa saeng sai sal san sang sao se sed sei sen seng seo seon sha shai shan shang shao she shen sheng shi shi ke shi wa shou shu shua shuai shuan shuang shui shun suo si so sol song sou su suan sui sun suo ta tae tai tan tang tao tap te teng teo teul teun ti tian tiao tie ting tol ton tong tou tu tuan tui tun tuo wa wai wan wang wei wen weng wie wo wu xi xia xian Xiang xiao xie xin xing xiong xiu xu xuan xue xun ya yanyan yang yao ye ye yen yi yin yin ying yo yong you yu yuan yue yug yun za za zad zai zan zang zao ze zei zen zeng zha zhai zhan zhang zhao zhe zhei zhen zheng zhi zhong zhou zhu zhua zhuai zhuan zhuang zhui zhun zhuo zi zo zong zou zu zuan zui zun zuo" & _
    "china love kiss you look me eye king bad quarter hour wind dozen passage landscape acridine Aberdonian" '英文单词
    
    PinYin = Split(TmpAllPinYin, " ")
    MaxCount = UBound(PinYin)
    
    If IsOnePinYin = False Then
        For i = 1 To OneToThreeRandom
            Randomize
            OneToThreeRandomPhoneticize = OneToThreeRandomPhoneticize & PinYin((MaxCount) * Rnd())
        Next i
    Else
        OneToThreeRandomPhoneticize = PinYin((MaxCount) * Rnd())
    End If
End Function

'*****************************************************
'
'生成0~9范围的一到三位随机数
'
'*****************************************************

Private Function OneToThreeRandomNumber() As Integer
    Dim i As Integer
    For i = 1 To OneToThreeRandom
        Randomize
        OneToThreeRandomNumber = OneToThreeRandomNumber & CInt(Int(10 * Rnd()))
    Next i
End Function

'*****************************************************
'
'生成a~z位随机一到三位小写字母
'
'*****************************************************

Private Function OneToThreeRandomSmallLetter() As String
    Dim i As Integer
    For i = 1 To OneToThreeRandom
        Randomize
        OneToThreeRandomSmallLetter = OneToThreeRandomSmallLetter & Chr(CInt(Int((26 * Rnd()) + 97)))
    Next i
End Function

'*****************************************************
'
'生成a~z随机一位小写字母
'
'*****************************************************

Private Function OneRandomSmallLetter() As String
    Randomize
    OneRandomSmallLetter = Chr(CInt(Int((26 * Rnd()) + 97)))
End Function

'*****************************************************
'
'生成A~Z随机一位大写字母
'
'*****************************************************

Private Function OneRandomCapitalLetter() As String
    Randomize
    OneRandomCapitalLetter = Chr(CInt(Int((26 * Rnd()) + 65)))
End Function

'*****************************************************
'
'生成0~9范围的一位随机数
'
'*****************************************************

Private Function OneRandomNumber() As Integer
    OneRandomNumber = OneRandomNumber & CInt(Int(10 * Rnd()))
End Function

'*****************************************************
'
'生成1~3范围的一位随机数
'
'*****************************************************

Private Function OneToThreeRandom() As Integer
    Randomize
    OneToThreeRandom = CInt(Int((3 * Rnd()) + 1))
End Function

'*****************************************************
'
'生成1~2范围的一位随机数
'
'*****************************************************

Private Function OneToTwoRandom() As Integer
    Randomize
    OneToTwoRandom = CInt(Int((2 * Rnd()) + 1))
End Function


然后用XMLHTTP提交数据。或者用WINHTTP!  下面是我程序里面的POST  淘宝注册部分!
    
'开始POST数据
    postAllData = "ret_url=http%3A%2F%2Fauction1.taobao.com%2Fauction%2Fbuy_item.jhtml"
    postAllData = postAllData & "%3Fcat_path%3D%252C50005998%252C50010398%252C%26item_id%3D"
    postAllData = postAllData & "3c1be3c0847e98dce6f7df6ed48256e0%26auction_type%3Db%26seller_id%3D"
    postAllData = postAllData & "f3a16ba4f8aff959c9abbee738fbff74%26secure_pay%3Dtrue%26x_id%3D"
    postAllData = postAllData & "0db2%26allow_quantity%3D339%26seller_nickname%3D%25C8%25D5%25D2%25BB%25CD%25C1%25D4%25C2%26"
    postAllData = postAllData & "who_pay_ship%3D%25C2%25F4%25BC%25D2%25B3%25D0%25B5%25A3%25D4%25CB%25B7%25D1"
    postAllData = postAllData & "%26current_price%3D208.00%26buy_now%3D208.00%26photo_url%3Di2%252FT1a1XcXhXhuQDVQwnX_115245.jpg"
    postAllData = postAllData & "%26pay_method%3D%25BF%25EE%25B5%25BD%25B7%25A2%25BB%25F5%26region%3D%25C9%25CF%25BA%25A3%26"
    postAllData = postAllData & "root_cat_id%3D50005998%26title%3D%25CC%25D8%25BC%25DB%25BB%25EE%25B6%25AF"
    postAllData = postAllData & "*%25C2%25F2%25C2%25ED%25BC%25D7%25CB%25CD%25B6%25C7%25B6%25B5*%25BC%25D2%25BC%25D2%25C0%25D6%25B7%25C0%25B7%25F8%25C9%25E4%25D4%25D0%25B8%25BE%25D7%25B0%2B%25D4%25D0%25B8%25BE%25B7%25C0%25B7%25F8%25C9%25E4%25B7%25FE&action=fast_Buy_action"
    postAllData = postAllData & "&_fma.f._0.u=" & URLEncoding(TaoBaoName) & "&_fma.f._0.p=" & TaoBaoPass & "&_fma.f._0.e=" & EmailName & "@263.com"
    postAllData = postAllData & "&_fma.f._0.r=yes&_fma.f._0.f=%C5%B7%DC%C6%BD%AD"
    postAllData = postAllData & "&_fma.f._0.m=13897913358&_fma.f._0.q=1"
    postAllData = postAllData & "&userId=f3a16ba4f8aff959c9abbee738fbff74"
    postAllData = postAllData & "&postageId=812192&_shipping_option=4"
    postAllData = postAllData & "&_fma.f._0.s=4&_fma.f._0.d=152525"
    postAllData = postAllData & "&n_prov=150000&n_city=152500&n_area=152525"
    postAllData = postAllData & "&_fma.f._0.de=%B0%A2%B6%FB%C3%C9%CC%F1502%BA%C5%C3%FB%D7%E5%C0%D6%C6%F7%D7%A8%C2%F4&_fma.f._0.po=810016"
    postAllData = postAllData & "&_fma.f._0.c=" & RegCode & "&_fma.f._0.a=1&itemId=3c1be3c0847e98dce6f7df6ed48256e0&xId=0db2&sellerId=f3a16ba4f8aff959c9abbee738fbff74&maxNum=339&whoPayShipping=%C2%F4%BC%D2%B3%D0%B5%A3%D4%CB%B7%D1&event_submit_do_fastBuy=anything&statThing=fastbuy1&submit=%3CSPAN%3E%C8%B7%B6%A8%3C%2FSPAN%3E"
    
    Set WinHttp = CreateObject("WinHttp.WinHttpRequest.5.1")
    WinHttp.Option(6) = 0                                             '禁止跳转
    WinHttp.SetTimeouts 5000, 5000, 30000, 5000                       '设置延时
    WinHttp.Open "POST", "", False
    WinHttp.SetRequestHeader "Referer", ""
    WinHttp.SetRequestHeader "Accept", "image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, application/x-shockwave-flash, application/vnd.ms-excel, application/vnd.ms-powerpoint, application/msword, */*"
    WinHttp.SetRequestHeader "Accept-Language", "zh-cn"
    WinHttp.SetRequestHeader "Accept-Encoding", "gzip, deflate"
    WinHttp.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    WinHttp.SetRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
    WinHttp.SetRequestHeader "Cache-Control", "no-cache"
    WinHttp.SetRequestHeader "Cookie", UserCookie
    
    WinHttp.Send (postAllData)
    
    While WinHttp.Status <> 200
        DoEvents
    Wend
    
    HtmlStr = BytesToBstr(WinHttp.ResponseBody, "gb2312")             '获取网页源码

    Set WinHttp = Nothing

看到需要换IP,再附加上ADSL操作类,希望喜欢编程的人喜欢,由于本人经常编写网络程序,所以这些是必备的代码!

Attribute VB_Name = "adsl操作"
Public Const RAS_MaxPhoneNumber = 128
Public Const RAS_MaxCallbackNumber = 128
Public Const UNLEN = 256
Public Const PWLEN = 256
Public Const DNLEN = 15
Public Const ERROR_INVALID_HANDLE = 6
Const RAS_MAXDEVICENAME     As Integer = 128
Const RAS_MAXDEVICETYPE     As Integer = 16
Const RAS_MAXENTRYNAME     As Integer = 256
Const RAS_RASCONNSIZE     As Integer = 412
Const ERROR_SUCCESS = 0&
Private Type RasConn
   dwSize   As Long
   hRasConn   As Long
   szEntryName(RAS_MAXENTRYNAME)   As Byte
   szDeviceType(RAS_MAXDEVICETYPE)   As Byte
   szDeviceName(RAS_MAXDEVICENAME)   As Byte
End Type

Type RASCONN95
   dwSize   As Long
   hRasConn   As Long
   szEntryName(RAS_MAXENTRYNAME)   As Byte
   szDeviceType(RAS_MAXDEVICETYPE)   As Byte
   szDeviceName(RAS_MAXDEVICENAME)   As Byte
End Type

Type RASENTRYNAME95
   'set   dwsize   to   264
   dwSize   As Long
   szEntryName(RAS_MAXENTRYNAME)   As Byte
End Type
  

Type RASDIALPARAMS
   dwSize   As Long     '1052
   szEntryName(RAS_MAXENTRYNAME)   As Byte
   szPhoneNumber(RAS_MaxPhoneNumber)   As Byte
   szCallbackNumber(RAS_MaxCallbackNumber)   As Byte
   szUserName(UNLEN)   As Byte
   szPassword(PWLEN)   As Byte
   szDomain(DNLEN)   As Byte
   '   注意98下不用定义后两个
   dwSubEntry   As Long
   dwCallbackId   As Long
End Type
        
  '   枚举所有的连接
  Declare Function RasEnumConnections Lib _
          "rasapi32.dll" Alias "RasEnumConnectionsA" _
          (lpRasConn As Any, lpcb As Long, lpcConnections _
          As Long) As Long
  Declare Function RasEnumEntries Lib _
          "rasapi32.dll" Alias "RasEnumEntriesA" (ByVal _
          reserved As String, ByVal lpszPhonebook As String, _
          lprasentryname As Any, lpcb As Long, lpcEntries _
          As Long) As Long
    
  '     拨号
  Declare Function RasDial Lib "rasapi32" _
          Alias "RasDialA" (DialExt As Long, ByVal _
          lpPhoneBook As String, _
          RasDialParam As RASDIALPARAMS, _
          ByVal NotifyType As Long, _
          ByVal Notifter As Long, _
          hRasConn As Long) As Long
  '   断开连接
  Private Declare Function RasHangUp Lib "rasapi32.dll" Alias "RasHangUpA" (ByVal hRasConn As Long) As Long
    

  '   获取错误信息
  Declare Function RasGetErrorString Lib "rasapi32" Alias "RasGetErrorStringA" (ByVal ErrValue As Long, ByVal lpErrStr As String, ByVal cSize As Long) As Long
  Public Declare Function RasGetEntryDialParams Lib "rasapi32.dll" Alias "RasGetEntryDialParamsA" (ByVal lpszPhonebook As String, lpRasDialParams As Any, blnPasswordRetrieved As Long) As Long
  Public Declare Function RasSetEntryDialParams _
              Lib "rasapi32.dll" Alias "RasSetEntryDialParamsA" _
                  (ByVal lpszPhonebook As String, _
                  lpRasDialParams As Any, _
                  ByVal blnRemovePassword As Long) As Long
  Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
                  (Destination As Any, Source As Any, ByVal Length As Long)
  



    
    
  '字节串转换
  Private Sub CopyByte(dest() As Byte, sour() As Byte)
          Dim sourL     As Long, sourU       As Long
          Dim destL     As Long, destU       As Long, I       As Long, j       As Long
          sourL = LBound(sour)
          sourU = UBound(sour)
          destL = LBound(dest)
          destU = UBound(dest)
          j = 0
          For I = sourL To sourU
                  dest(destL + j) = sour(I)
                  j = j + 1
                  If j >= (destU - destL) + 1 Then
                        Exit For
                  End If
          Next I
  End Sub

'此处调用将拨号
Public Sub OpenAdsl(RasName)
     Dim username As String, Pswd As String
     Dim RasDialPara     As RASDIALPARAMS
     Dim len5     As Long, I       As Long
     Dim hRasConn     As Long
     Dim bya()     As Byte
     Dim p     As Long
     GetUserAndPassword RasName, username, Pswd
     '   注意此处98系统和2000系统不一致,98中为1052
     RasDialPara.dwSize = 1060
     bya = StrConv(RasName, vbFromUnicode) + ChrB(0)
     Call CopyByte(RasDialPara.szEntryName, bya)
     l = RasGetEntryDialParams(vbNullString, RasDialPara, p)
     '若使用以下CallBack   function的方式,则RasDial()不等连线成功或失败便结束。
     'di   =   RasDial(0,   PhoneBook,   RasDialPara,   0,   AddressOf   RasDialFunc,   hRasConn)
     '若第二、三个叁数都是0则,RasDial会等连线成功或失败後才执行下一行指令
     di = RasDial(ByVal 0&, vbNullString, RasDialPara, 0, 0, hRasConn)
     If di = 0 Then
        DialUp = hRasConn
     Else
        DialUp = 0
        Dim str5     As String
        str5 = String(255, Chr(0))
        Call RasGetErrorString(di, str5, 256)
        MsgBox Left(str5, InStr(1, str5, Chr(0)) - 1), vbCritical
        Call RasHangUp(hRasConn)
     End If
    
  End Sub

  '此处调用可获取默认连接名
  Public Function GetDefaultAdslName() As String
          Dim s     As Long, l       As Long, ln       As Long, a$
          Dim R     As RASENTRYNAME95
          R.dwSize = 264
          s = 256 * R.dwSize
          l = RasEnumEntries(vbNullString, vbNullString, R, s, ln)
          DefaultRas = StrConv(R.szEntryName(), vbUnicode)
  End Function
  
  '此处可得到所有的连接名
  Public Sub GetAllAdslName(Combo1 As ComboBox)
          Combo1.Clear
          Dim s As Long
          Dim l As Long
          Dim ln As Long
          Dim a$
          ReDim R(255) As RASENTRYNAME95
          R(0).dwSize = 264
          s = 256 * R(0).dwSize
          l = RasEnumEntries(vbNullString, vbNullString, R(0), s, ln)
          For l = 0 To ln - 1
                  a$ = StrConv(R(l).szEntryName(), vbUnicode)
          '注意VB中字符串的表达方式
                  Combo1.AddItem Left$(a$, InStr(a$, Chr$(0)) - 1)
          Next
          Combo1.ListIndex = 0
  End Sub

'获取对应拨号连接的用户名和密码的子程序
  Public Function GetUserAndPassword(RasName, ByRef username As String, ByRef Pswd As String)
          Dim RasDialPara     As RASDIALPARAMS
          Dim len5     As Long, I       As Long
          Dim hRasConn     As Long
          Dim bya()     As Byte
          Dim p     As Long
          '   注意此处98系统和2000系统不一致
          RasDialPara.dwSize = 1060
          bya = StrConv(RasName, vbFromUnicode) + ChrB(0)
          Call CopyByte(RasDialPara.szEntryName, bya)
          l = RasGetEntryDialParams(vbNullString, RasDialPara, p)
          a$ = StrConv(RasDialPara.szUserName, vbUnicode)
          username = Left$(a$, InStr(a$, Chr$(0)) - 1)
          a$ = StrConv(RasDialPara.szPassword, vbUnicode)
          Pswd = Left$(a$, InStr(a$, Chr$(0)) - 1)
  End Function

'此处调用断开联接
Public Function CloseAdsl() As Boolean
   Dim I     As Long, j       As Long
   Dim lpRasConn(255)     As RasConn
   Dim lpcb     As Long
   Dim lpcConnections     As Long
   Dim hRasConn     As Long
   Dim gstrISPName     As String
   Dim ReturnCode     As Long
   Dim ByteToString     As String
   lpRasConn(0).dwSize = RAS_RASCONNSIZE
   lpcb = RAS_MAXENTRYNAME * lpRasConn(0).dwSize
   lpcConnections = 0
   ReturnCode = RasEnumConnections(lpRasConn(0), lpcb, lpcConnections)
   If ReturnCode = ERROR_SUCCESS Then
      For I = 0 To lpcConnections - 1
         j = 0
         ByteToString = ""
         While lpRasConn(I).szEntryName(j) = 0
            ByteToString = ByteToString & Chr(lpRasConn(I).szEntryName(j))
            j = j + 1
         Wend
         If Trim(ByteToString) = Trim(gstrISPName) Then
            hRasConn = lpRasConn(I).hRasConn
            ReturnCode = RasHangUp(ByVal hRasConn)
         End If
      Next I
   End If
   CloseAdsl = ReturnCode
End Function





阅读(5544) | 评论(0) | 转发(1) |
给主人留下些什么吧!~~