应该是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
阅读(6608) | 评论(0) | 转发(1) |
